Access Macro Converted to VBA then Editted only Executing Access Defined Code - ms-access

I have set up a basic macro where I export the contents of a table to excel. Macro works great, but now I want to create a check to see if the file name that I am saving to already exists, and if so, deletes that file so that I do not have the user deal with the prompt box asking if they would like to overwrite the file.
I converted the macro to VBA so that I could add in the desired dir(filename) and kill(filename) code. Once completed I was able to successfully run the code in the VBA editor, however, when I tried running the code based on the "on close" event of a form I have in access, it will only run the code as viewed in the access macro structure, as if I never added any additional lines of code in the VBA editor. Is there something that I was supposed to do to convert back from VBA to Access once I completed my edits?
Please see below for code that I would like to execute:
Function ExportLot()
On Error GoTo ExportLot_Err
Dim filename As String
filename = "\\server1\Trial
Database for QS Reports\Lot Log Report.xlsx"
DeleteFile (filename)
DoCmd.OutputTo acOutputQuery, "LLUnion", "ExcelWorkbook(*.xlsx)", filename, False, "", , acExportQualityPrint
ExportLot_Exit:
Exit Function
ExportLot_Err:
MsgBox Error$
Resume ExportLot_Exit
End Function
Function FileExists(ByVal FileToTest As String) As Boolean
FileExists = (Dir(FileToTest) <> "")
End Function
Sub DeleteFile(ByVal FileToDelete As String)
If FileExists(FileToDelete) Then 'See above
' First remove readonly attribute, if set
SetAttr FileToDelete, vbNormal
' Then delete the file
Kill FileToDelete
End If
End Sub
Original converted code (what currently runs when I call ExportLot from the form):
Function ExportLot()
On Error GoTo ExportLot_Err
Dim filename As String
DoCmd.OutputTo acOutputQuery, "LLUnion", "ExcelWorkbook(*.xlsx)","\\server1\Trial Database for QS Reports\Lot Log Report.xlsx", False,"", , acExportQualityPrint
ExportLot_Exit:
Exit Function
ExportLot_Err:
MsgBox Error$
Resume ExportLot_Exit
End Function

I managed to figure out either the solution to or a work around for this problem. I created a new macro (ExecuteCloseCode), and used the RunCode Event to call my function (ExportLot()) as defined in the question.
Then I used the on close event to call the "ExecuteCloseCode".
I am not sure why this method worked and my previously proposed efforts did not...

Related

Detect if certain named workbook is open. error 53

I used the code provided by Siddharth Rout in the following threat.
Detect whether Excel workbook is already open
My goal was to check if a certain named workbook was open and depending on the result perform certain actions.
This was the result.
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
The following piece refers back to the function and depending on the result performs certain actions.
Dim xls As Object
Dim Answer As String
Dim Mynote As String
If IsWorkBookOpen(Environ("USERPROFILE") & "\Desktop\Report.xlsm") =
True Then
Mynote = "The Report is still open. Do you want to save the Report ?"
Answer = MsgBox(Mynote, vbQuestion + vbYesNo, "Warning Report open")
If Answer = vbYes Then
MsgBox "Please Save your Report under a new name and close it. then press update again"
Exit Sub
Else
Set xls = GetObject(Environ("USERPROFILE") & "\Desktop\Report.xlsm")
xls.Close True
End If
Else
End If
This used to work perfectly in the past but since today it suddenly gives me error 53.
While trying to resolve the issue I discovered the error only occurs when the named workbook is not on the desktop. Strangely enough it did not have this issue in the past. I specifically tested that because the file will not always be on the desktop.
I tried several backups tracking back 2 months and even those show the same error now.
While searching the internet for this issue i found this thread,
Check if excel workbook is open?
where they suggest to change the following pieces,
(ErrNo = Err) in to (Errno = Err.Number)
(ff = FreeFile_()) in to (ff = FreeFile)
I did both together and independitly. eventhough i dont really see the relation between the error and Freefile.
This did not change the error at all.
While I am currious to why this error suddenly occurs I really do need a solution or alternative.
what i need it tot do again is,
- Check if named workbook is open.
- when it is open a Msgbox with yes and no option should appear.
- On "No" it should close the named workbook and continue with whatever is below of what i posted.
- On yes it should pop a message box and stop.
Any help that can be provided will be highly appreciated.
You need to check if the file exists before checking if it is open;
Function FileExists(ByVal strFile As String, Optional bFindFolders As Boolean) As Boolean
'Purpose: Return True if the file exists, even if it is hidden.
'Arguments: strFile: File name to look for. Current directory searched if no path included.
' bFindFolders. If strFile is a folder, FileExists() returns False unless this argument is True.
'Note: Does not look inside subdirectories for the file.
'Author: Allen Browne. http://allenbrowne.com June, 2006.
Dim lngAttributes As Long
'Include read-only files, hidden files, system files.
lngAttributes = (vbReadOnly Or vbHidden Or vbSystem)
If bFindFolders Then
lngAttributes = (lngAttributes Or vbDirectory) 'Include folders as well.
Else
'Strip any trailing slash, so Dir does not look inside the folder.
Do While Right$(strFile, 1) = "\"
strFile = Left$(strFile, Len(strFile) - 1)
Loop
End If
'If Dir() returns something, the file exists.
On Error Resume Next
FileExists = (Len(Dir(strFile, lngAttributes)) > 0)
End Function

Run Sub-procedure with Procedure name as a string

I'm wanting to run a procedure from a form that was open via openargs
This is how I am opening the form.
DoCmd.OpenForm "Loading_Form", acNormal, , , , acWindowNormal, DynaProgBarMax & "|" & DynaLableCaption & "|" & ProcCall & "|"
This is what is ran when the form opens.
Private Sub Form_Open(Cancel As Integer)
Dim OpenArgsAry As Variant
OpenArgsAry = Split(Me.OpenArgs, "|")
Me.DynaProgBar.Max = OpenArgsAry(0)
Me.DynaLable.Caption = OpenArgsAry(1)
Run OpenArgsAry(2)
End Sub
I am having an issue with Run OpenArgsAry(2). I'm getting an error stating that the Procedure can not be found. OpenArgsAry(2) is containing a string "Forms(""Stuff"").PrintAllStuff()". When I Replace Run OpenArgsAry(2) with Run Forms("Stuff").PrintAllStuff() it works fine.
Run is suppose to be able to run a string as the procedure name is it not?
Run requires a procedure (sub or function in a global module, not a form or class module). PrintAllStuff is a method on a form, thus can't be executed through Run.
However, you can execute it through CallByName:
CallByName Forms("Stuff"), OpenArgsAry(2), vbMethod
Where OpenArgsAry(2) only contains PrintAllStuff. You can use Me instead if you want to execute the method on the current form.

Use vba to refresh & renew table links

I have designed a system that is used to track customer activity and log calls to a department. The front end and back end database are written in access. This system is due to go to the USA division of the company i work for.
The front end needs to automatically refresh the tables and if the backend database has moved (which it will when i send it to the US) the code will then look at a function to read the location of the new database. Sample of the read text file function code shown below:
Function ReadDbPassword()
'--
' Filetostring(FILEInput$ as variant) ' to make this a callable function
Dim FILEInput As Variant
'--
On Error GoTo FileToString_Error
FILEInput = "C:\Users\Public\databaseUser\PassCon"
Passmyfile = FreeFile
Open FILEInput For Input As Passmyfile
Passthedata4 = Input(LOF(Passmyfile), Passmyfile)
Close Passmyfile
On Error GoTo 0
Exit Function
FileToString_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
End Function
The text file contains a path like the one below:
P:\Projects\Database.accdb
I have found code that uses a similar idea to what i want and i have been looking at the code on the link below, however i do not fully understand how this code works in order to alter it to what I need to use the read text file.
http:/ /access.mvps.org/access/tables/tbl0009.htm
-------EDIT --------
I have tried to edit the following section to use the read text function
Function fGetMDBName(strIn As String) As String
'Calls GetOpenFileName dialog
Dim strFilter As String
strFilter = ahtAddFilterItem(strFilter, _
"Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
"*.mdb; *.mda; *.mde; *.mdw")
strFilter = ahtAddFilterItem(strFilter, _
"All Files (*.*)", _
"*.*")
fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
OpenFile:=True, _
DialogTitle:=strIn, _
Flags:=ahtOFN_HIDEREADONLY)
End Function
By replacing all the code with
fGetMDBName = Passmyfile
You are mixing apples and oranges in what you are trying to do. Here are my suggestions:
Make sure your module has 'Option Explicit' then compile all your code. I see variables referenced but have no idea what TYPE they are.
Change your Function 'ReadDbPassword()' to return a string variable, then set it to return Passthedata4.
The second Function you listed (fGetMDBName) is opening a File Dialog box to allow you to select a file name. You do not need that since you already will have the file path/name from your first Function.
Then adapt the code you found that does the relink to use the path/name from your subroutine.

Use a button to Enable/Disable a text box in VBA

I have a form with a text box named Contract_Applying_for which is disabled on form load, but I want to have a button which allows me to edit the contents of the text box.
When I add a button I get presented with the Command Button Wizard, so I have created a Macro called ToggleEnableButton which has the instruction to
RunCode Function Name "=ToggleEnableButton()"
Then I have written the function
Function ToggleEnableButton()
If Me.Contract_Applying_for.Enabled = True Then
Me.Contract_Applying_for.Enabled = False
Else
Me.Contract_Applying_for.Enabled = True
End If
End Function
This seems to produce the error "Member already exists in an object module from which this object module derives."
The code for the ToggleEnableButton_Click is automatically created by the Command Button Wizard and is
Private Sub ToggleEnableButton_Click()
On Error GoTo Err_ToggleEnableButton_Click
Dim stDocName As String
stDocName = "ToggleEnableMacro"
DoCmd.RunMacro stDocName
Exit_ToggleEnableButton_Click:
Exit Sub
Err_ToggleEnableButton_Click:
MsgBox Err.Description
Resume Exit_ToggleEnableButton_Click
End Sub
Any suggestion of what I am doing wrong or a better way to approach this.
Seems like a very simple thing that I am trying to do, but quite a long winded approach.
As suggested by Peekay in the comments I have tried to use a checkbox instead, I wrote
Private Sub chbToggleEdit_Click()
If Me.chbToggleEdit.Value = False Then
Me.Contract_Applying_for.Enabled = False
Else
Me.Contract_Applying_for.Enabled = True
End If
End Sub
This gives the error: "A problem occurred while Microsoft Access was communication with the OLE server or ActiveX Control."
Can you not simply have:
Private Sub ToggleEnableButton_Click()
On Error GoTo Err_ToggleEnableButton_Click
ToggleEnableButton()
Exit_ToggleEnableButton_Click:
Exit Sub
Err_ToggleEnableButton_Click:
MsgBox Err.Description
Resume Exit_ToggleEnableButton_Click
End Sub
You can declare your function with the code behind your form.
Let me know if that works,
Ash

Is it possible to reference an unsaved query?

Frequently I drop ready-made queries into Access. Create > Query Design > SQL, and paste the code directly to the text window.
Generally I do not save these queries in Access because I have to minimize the clutter of one-time, ad hoc reporting. I wrote a macro for Access that will automatically save the results of an established query...
Sub qry40T_export()
'export the results of the query "qry40T" to local excel file
'prompt the user for the save location
'name the file "qry40T_output.xls"
'initialize variable type
Dim save_dir As String
save_dir = "dunno_yet"
'initialize default filename
savefile_name = "qry40T_output.xls"
'prompt user for save location
save_dir = InputBox(Prompt:="Save query export to the following directory:", Title:="Save file to:", _
Default:="F:\QUERYDATA\")
'validate user submitted
If save_dir = "" Then
'user chose 'Cancel'
Exit Sub
End If
'compose full save filename
fullsavefile_name = save_dir & savefile_name
'edit error treatment
On Error GoTo ErrHandler
'export the query
'overwrite "qry40T_output.xls"
DoCmd.OutputTo acOutputQuery, "qry40T", "Excel97-Excel2003Workbook(*.xls)", fullsavefile_name, False, "", , acExportQualityPrint
'success
MsgBox ("Export successful.")
'restore error treatment
On Error GoTo 0
'error handling resolution
subexit:
Exit Sub
'error handling message
ErrHandler:
MsgBox Error$
Resume subexit
End Sub
...but now I would like to apply this same process to an unsaved query. Is that possible? My guess is that the code would look something like this: DoCmd.OutputTo acOutputQuery, OpenQuery(1), "Excel97-Excel2003Workbook(*.xls)", fullsavefile_name, False, "", , acExportQualityPrint, but I can't seem to find the right syntax.
Since these are 'throw-away' queries and don't need to be saved, you could save them with the same query name every time.
For example, you can always save your temporary queries as "qry40T". Then, your macro will always work and save the results of whatever query is saved in qry40T at the time.