I hope you can help me out here...
I have a application in MS Access 2013 (.accdb). I have a file dialog function on the button click. (MSGBOX Functions are for debuging!)
Private Sub Browse_btn_Click()
Dim path As String, initialPath As String
Dim fd As Object
MsgBox "Function Starts"
On Error GoTo errhnd
If IsNull(Me.RPE_Txt.value) Then initialPath = "C:\users\" & Environ("USERNAME") & "\" _
Else: initialPath = Me.RPE_Txt.value
MsgBox "Setting FD"
Set fd = Application.FileDialog(3)
On Error GoTo errhnd
With fd
MsgBox "in fd with statement"
.Title = "RPE File"
MsgBox "fd.initialview"
.InitialView = 2
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.csv"
.InitialFileName = initialPath
MsgBox "show"
.Show
MsgBox "path"
path = .SelectedItems(1)
End With
MsgBox "end with"
Me.RPE_Txt.value = path
Exit Sub
errhnd:
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
End Sub
When I run this on MS Access Runtime 2010 I am getting standard RunTime Error when I click the button and Access crashes...
I tried adding references with below code but it was crashing in the attempt..
If Application.Version = 14# Then
MsgBox "Office 2010"
If Dir("C:\Program Files\Common Files\microsoft shared\OFFICE14\MSO.DLL") <> "" And Not refExists("OFFICE") Then
MsgBox "Applying Reference for 2010 Office"
'Application.References.AddFromFile "C:\Program Files\Common Files\microsoft shared\OFFICE14\MSO.dll"
Application.References.AddFromGuid "{398E906A-826B-48DD-9791-549C649CACE5}", 14#, 14#
MsgBox "Office 2010 Reference Applied!"
End If
ElseIf Application.Version = 15# Then
MsgBox "Office 2013"
If Dir("C:\Program Files\Common Files\microsoft shared\OFFICE15\MSO.dll") <> "" And Not refExists("OFFICE") Then
MsgBox "Applying Reference for 2013 Office"
Application.References.AddFromFile "C:\Program Files\Common Files\microsoft shared\OFFICE15\MSO.dll"
MsgBox "Office 2013 Reference Applied!"
End If
End If
Any help would be appreciated!
Thanks,
Pete !
Sadly, the FileDialog doesn't work in the runtime.
An often referred replacement code can be found here:
API: Call the standard Windows File Open/Save dialog box
It's longwinded but it works.
Related
In my form access I want to make a button to browse / choose an excel file and import it in format a table in access.
This is my code.
' Requires reference to Microsoft Office 15.0 Object Library. '
Public Function ImportDocument() As TaskImportEnum
On Error GoTo ErrProc
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Dialog Title"
With .Filters
.Clear
.Add "xlsx documents", "*.xlsx", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False 'Change this to TRUE to enable multi-select
'If aborted, the Function will return the default value of Aborted
If .Show = 0 Then GoTo Leave
End With
Dim selectedItem As Variant
For Each selectedItem In fd.SelectedItems
DoCmd.TransferText acImportDelim, "Raw Data from Import_ Import Specification", "Raw Data from Import", selectedItem, True, ""
Next selectedItem
ImportDocument = TaskImportEnum.Success
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Function
ErrProc:
MsgBox err.Description, vbCritical
ImportDocument = TaskImportEnum.Failure 'Return Failure if error
Resume Leave
End Function
The code in question is part of a solution provided here. However, a few changes are required as the solution provided relates to a CSV file import.
In a Standard Module, paste the following:
Public Enum TaskImportEnum
Aborted = 0 'default
Success
Failure
End Enum
Public Function ImportDocument() As TaskImportEnum
On Error GoTo ErrProc
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Dialog Title"
With .Filters
.Clear
.Add "Excel documents", "*.xlsx", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False 'Change this to TRUE to enable multi-select
'If aborted, the Function will return the default value of Aborted
If .Show = 0 Then GoTo Leave
End With
Dim selectedItem As Variant
For Each selectedItem In fd.SelectedItems
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "YourTableName", selectedItem, True, "YourSheetName$" 'Change 'YourTableName' and 'YourSheetName' to the actual names
Next selectedItem
'Return Success
ImportDocument = TaskImportEnum.Success
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Function
ErrProc:
MsgBox Err.Description, vbCritical
ImportDocument = TaskImportEnum.Failure 'Return Failure if error
Resume Leave
End Function
On your button's Click event paste the following:
Dim status_ As TaskImportEnum
status_ = ImportDocument
Select Case status_
Case TaskImportEnum.Success:
MsgBox "Success!"
Case TaskImportEnum.Failure:
MsgBox "Failure..."
Case Else:
MsgBox "Aborted..."
End Select
I am receiving a ByRef argument type mismatch. The following code (varFile specificaly) is highlighted for the error:
Call InsertCMS_Reports_2ndSave(varFile)
Here is my form:
Option Compare Database
'Private Sub Command0_Click()
Private Sub cmdFileDialog_Click()
'Requires reference to Microsoft Office 12.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
'Clear listbox contents.
'Me.FileList.RowSource = ""
'Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
'Allow user to make multiple selections in dialog box.
.AllowMultiSelect = True
'Set the title of the dialog box.
.Title = "Please select one or more files"
.InitialFileName = "C:\Users\ABCDEF\Desktop\CCCEEe CMS Reports"
'Clear out the current filters, and add our own.
.Filters.Clear
'.Filters.Add "Access Databases", "*.MDB; *.ACCDB"
.Filters.Add "Access Projects", "*.txt"
'.Filters.Add "All Files", "*.*"
'Show the dialog box. If the .Show method returns True, the
'user picked at least one file. If the .Show method returns
'False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to the list box.
For Each varFile In .SelectedItems
' Me.FileList.AddItem varFile
Call InsertCMS_Reports_2ndSave(varFile)
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
Module Code:
Function InsertCMS_Reports_2ndSave(FileName As String)
'DoCmd.DeleteObject CopyOfCOMPRPT_CE, "CMS_Reports_2ndSave"
DoCmd.TransferText acImportFixed, "CMS_Reports_Import", _
"CMS_Reports_Import", "C:\Users\A088982\Desktop\January CMS reports for Centene\FileName"
CurrentDb.Execute "UPDATE CopyOfCOMPRPT_CE SET FileName = 'HLTH_COMPRPT_1701011028174_h0062.txt' WHERE FileName is NULL", dbFailOnError
End Function
The reason you're receiving this error is because you've dimensioned varFile as a variant, however your function is expecting a string. Try this instead:
Function InsertCMS_Reports_2ndSave(FileName)
Others have had issues with the MSACCESS.EXE process not closing (from Task Manager) when exiting their databases. Each of the posts I've read have had something to do with not properly closing recordset variables.
When I exit the database I'm working on, I notice the MSACCESS.EXE process moves from the "Apps" section to "Background Processes" in Win 10 Task Manager. This hung process continues to utilize RAM. I'm certain that I'm closing all recordset variables properly.
Through a lot of debugging, I figured out a simple way to replicate the problem:
Create two forms in a new Access database. Set the PopUp property to True for one of them and False for the other. Save the forms "PopUp" and "NoPopUp" and close the database.
Open Task Manager to view the processes running on your screen.
Open your Access database and open the NoPopUp form. Note the MSACCESS.EXE process under Apps.
Close your database. Note that MSACCESS.EXE is removed from your list of Processes (both under "Apps" and "Background Processes").
Now reopen your Access database and open form PopUp. Then close the database.
Note that the MSACCESS.EXE process moves from the "Apps" section to "Background Processes" and is still utilizing system memory.
Additional MSACCESS.EXE processes hang in Task Manager each time the database is closed after opening a form with its Pop-up property set to True.
My database uses a ton of Pop-up forms. How should I be closing my database so that these hung processes aren't stacking up? (I'm using Access 2013 in Windows 10.)
Thanks,
Sam
How are you closing your database now?
Can you change the command to call a function.
Then in that function call a routine that closes all open forms
You may have to add parameter to close without saving - depending on your results.
Function CloseAllOpenFrms()
On Error GoTo Error_Handler
Dim DbF As Access.Form
Dim DbO As Object
Set DbO = Application.Forms 'Collection of all the open forms
For Each DbF In DbO 'Loop all the forms
DoCmd.Close acForm, DbF.Name, acSaveNo
Next DbF
Error_Handler_Exit:
On Error Resume Next
Set DbF = Nothing
Set DbO = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: CloseAllOpenFrms" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
From http://www.devhut.net/2015/02/17/ms-access-vba-close-all-open-forms/
Try this very basic example in a new sample database.
EDIT: Add a Sleep and DoEvents after every close form in case of caching/fast cpu getting ahead of code? Last attempt to fix weird issue.
In Module 1
Option Compare Database
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Function CloseAllOpenFrms()
On Error GoTo Error_Handler
Dim DbF As Access.Form
Dim DbO As Object
Set DbO = Application.Forms 'Collection of all the open forms
' Close all popups first
For Each DbF In DbO 'Loop all the forms
If DbF.PopUp Then
DoCmd.Close acForm, DbF.Name, acSaveNo
DoEvents
Sleep 1000
End If
Next DbF
' Close remaining forms
For Each DbF In DbO 'Loop all the forms
DoCmd.Close acForm, DbF.Name, acSaveNo
DoEvents
Sleep 1000
Next DbF
Application.Quit acQuitSaveNone
Error_Handler_Exit:
On Error Resume Next
Set DbF = Nothing
Set DbO = Nothing
Exit Function
Error_Handler:
MsgBox "Error closing : " & DbF.Name & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "Error closing form"
Resume Error_Handler_Exit
End Function
Create basic Form1 with two command buttons:
Command button Command1 (Caption= Open Popup Form)
Command button Command0 (Caption = Exit DB)
In Form1's form module paste text
'------------------------------------------------------------
' Command1_Click
'
'------------------------------------------------------------
Private Sub Command1_Click()
On Error GoTo Command1_Click_Err
CloseAllOpenFrms
Command1_Click_Exit:
Exit Sub
Command1_Click_Err:
MsgBox Error$
Resume Command1_Click_Exit
End Sub
'------------------------------------------------------------
' Command0_Click
'
'------------------------------------------------------------
Private Sub Command0_Click()
On Error GoTo Command0_Click_Err
DoCmd.OpenForm "Form2-popup", acNormal, "", "", , acWindowNormal
Command0_Click_Exit:
Exit Sub
Command0_Click_Err:
MsgBox Error$
Resume Command0_Click_Exit
End Sub
Create another form Form2-popup and set Popup property to true
Add command button Command1 with caption "Exit Form"
'------------------------------------------------------------
' Command1_Click
'
'------------------------------------------------------------
Private Sub Command1_Click()
On Error GoTo Command1_Click_Err
DoCmd.Close , ""
Command1_Click_Exit:
Exit Sub
Command1_Click_Err:
MsgBox Error$
Resume Command1_Click_Exit
End Sub
I have an Access file which I will be using for quality assurance of data.
I will be inputting data from three Excel files, each into its own Access table.
At present, I have three buttons and corresponding text boxes. I manually enter the file path and name into the text box, click the button and it completes the rest of my macro, importing the data.
I'd like to use the file picker dialog box to populate the textbox with the path.
This code and worked for me:
Private Sub Comando32_Click()
Dim f As Object
Dim strFile As String
Dim strFolder As String
Dim varItem As Variant
Set f = Application.FileDialog(3)
f.AllowMultiSelect = False
If f.Show Then
For Each varItem In f.SelectedItems
strFile = Dir(varItem)
strFolder = Left(varItem, Len(varItem) - Len(strFile))
MsgBox "Folder: " & strFolder & vbCrLf & _
"File: " & strFile
Me.certidao.Value = varItem
Next
End If
Set f = Nothing
End Sub
Of course, it is possible to call the file Dialog API in VBA!
An example direct from Microsoft VBA documentation:
Private Sub cmdFileDialog_Click()
' Requires reference to Microsoft Office XY.0 Object Library.
Dim fDialog As Office.FileDialog
Dim varFile As Variant
' Clear listbox contents.
Me.FileList.RowSource = ""
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
' Allow user to make multiple selections in dialog box
.AllowMultiSelect = True
' Set the title of the dialog box.
.Title = "Please select one or more files"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Access Databases", "*.MDB"
.Filters.Add "Access Projects", "*.ADP"
.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varFile In .SelectedItems
Me.FileList.AddItem varFile
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
Please note you have to include a reference to Microsoft Office 11.0 Library
(in code window, select menu option Tools, Reference and select your library for the correct version of your Office Version)
Thanks for the response.
I did google it first and tried everything I came across. I also came across the very set of code pasted above. I Played around with it for a while and whatever I did returned errors. I decided to try the code in Excel instead of Access and it worked straight away. The only thing I could think was that the code wasn't applicable to access. Following all of that I asked the question here.
Private Sub cmdDialog_Click()
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Me.txtFileSelect.RowSource = ""
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Please select one or more files"
.Filters.Clear
.Filters.Add "Excel Files", "*.XLSX"
.Filters.Add "All Files", "*.*"
If .Show = True Then
For Each varFile In .SelectedItems
Me.txtFileSelect.AddItem varFile
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
With this code I get:
Compile error;
User-defined type not identified
Try this code, for single file:
MyFileURL = aBrowseForFile("C:\users\")
Public Function aBrowseForFile(aStartFolder As String) As String
' Needs a reference to Microsoft Office Object Library 15.0
On Error GoTo Err_txtBrowseForFile
Dim fDialog As Office.FileDialog
Dim varfile As Variant
Dim strPath As String
Dim strFilter As String, strFileName As String
Dim Main_Dir As String, DefFolder As String
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.InitialView = msoFileDialogViewThumbnail
.AllowMultiSelect = False
.Title = "Please select one or more files"
.InitialFileName = aStartFolder
.InitialView = msoFileDialogViewThumbnail
.Filters.Clear
.Filters.Add "all files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
aBrowseForFile = .SelectedItems(1)
Else
'MsgBox "You clicked Cancel in the file dialog box."
End If
End With
Exit_txtBrowseForFile:
Exit Function
Err_txtBrowseForFile:
MsgBox Err.Description, vbCritical, "MyApp"
Resume Exit_txtBrowseForFile
End Function
Put this function in a module, as it is.
Do not put some other code inside, so you can call it in other projects and build your own tools set.
Call it as shown above in your form.
This code runs well and it is tested.
If you want to check this code, in the debug window type
debug.print aBrowseForFile("C:\users\")
and see what happens. If you have other run-time or compile errors, please post another question.
Hope this helps
Thanks for the response.
I solved the problem in the end, I hadn't selected the object database. I found the following code to work:
Private Sub cmdInput_Click()
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Title = "Please select a file"
.Filters.Clear
.Filters.Add "Excel Files", "*.XLSX"
.Filters.Add "All Files", "*.*"
If .Show = True Then
For Each varFile In .SelectedItems
DoCmd.TransferSpreadsheet acImport, 10, "InputData", varFile, True, ""
Beep
MsgBox "Import Complete!", vbExclamation, ""
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
End If
End With
End Sub
Set fd = Application.FileDialog(3)
fd.Title = "Select A File"
fd.AllowMultiSelect = True
fd.Filters.Clear
fd.Filters.Add "CSV File", "*.CSV"
If fd.Show = True Then
For Each varFile In fd.SelectedItems
GetFileName = varFile
If fd.SelectedItems.Count > 0 Then
MsgBox "File choosen = " & fd.SelectedItems.Count
Else
MsgBox "No file was selected"
Exit Sub
End If
Next
End If
Whenever I run this in VBA, a prompt open to select a file and if I select any number of files, the program runs properly . While if I click 'cancel' instead of selecting files, the program does not exit the sub and just exists the what may be the error ? Thanks
In VBA -1 evaluates to True. So your best bet is to do something like this:
Set fd = Application.FileDialog(3)
fd.Title = "Select A File"
fd.AllowMultiSelect = True
fd.Filters.Clear
fd.Filters.Add "CSV File", "*.CSV"
Dim FileChosen As Integer
FileChosen = fd.Show
If FileChosen <> -1 Then
MsgBox "No file was selected"
Exit Sub
Else
For Each varFile In fd.SelectedItems
MsgBox "File choosen = " & varFile
End For
End If