pdvsa
asked on
Allow user to choose the file to import (loops 2x)
Hello Experts,
I have the following code below.
It imports an excel according to what user chooses, runs a macro, and appends to an archive file .
It works OK
My problem is that it loops through it twice meaning I get 2 prompts for user to select the file. (it imports the required one time (not 2x) though).
I have attached a db with the necessary files however you might be able to see the error in the codes below.
Also, I have attached the excel file just in case you want to import from your desktop (will need to change path).
here are the codes:
thank you in advance...
Function:
Import_FC.xlsm
I have the following code below.
It imports an excel according to what user chooses, runs a macro, and appends to an archive file .
It works OK
My problem is that it loops through it twice meaning I get 2 prompts for user to select the file. (it imports the required one time (not 2x) though).
I have attached a db with the necessary files however you might be able to see the error in the codes below.
Also, I have attached the excel file just in case you want to import from your desktop (will need to change path).
here are the codes:
thank you in advance...
Private Sub cmdImport_Click()
Dim FName As String 'added lin ***
FName = getFileName() 'added lin ***
If FName = "" Then 'added lin ***
MsgBox "You clicked Cancel in the file dialog box."
Exit Sub 'added line ***
End If 'added line ***
' If MsgBox("Do you want to Append data to Archive?", vbYesNo) <> vbYes Then
DoCmd.OpenQuery "qryAppend_ImportFC" 'appends to an archive
' Exit Sub
' End If
Dim strName As String
Dim xl As Object
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open (getFileName()) ' Modified line ***
xl.Run "Transpose2"
xl.ActiveWorkbook.Close (True)
xl.Quit
Set xl = Nothing
' If MsgBox("Do you want to Import and Delete data?", vbYesNo) <> vbYes Then
CurrentDb.Execute "delete * from [Import_FC]"
' Exit Sub
' End If
strName = "Transpose"
DoCmd.TransferSpreadsheet acImport, , "Import_FC", "C:\Users\pdvsa\Desktop\Import_FC.xlsm", True, strName & "!"
DoCmd.OpenQuery "qryDeleteNullsImportFC"
End Sub
Function:
Function getFileName() As String
Dim fDialog As Office.fileDialog
Dim varFile As Variant
Set fDialog = Application.fileDialog(msoFileDialogFilePicker)
With fDialog
.Title = "Please select your file"
.Filters.Add "Access Databases", "*.xlsm"
' .Filters.Add "Access Projects", "*.accrd" add any other ***
.Filters.Add "All Files", "*.*"
If .Show = True Then
getFileName = .SelectedItems(1)
Else
getFileName = ""
End If
End With
End Function
EE_fileDialog.accdbImport_FC.xlsm
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
As mentioned by previous comments.
xl.Workbooks.Open (getFileName()) ' Modified line *** modified to xl.Workbooks.Open (FName) ' Modified line ***
The old statement runs the function again. FName is the variable given to the file in question.
xl.Workbooks.Open (getFileName()) ' Modified line *** modified to xl.Workbooks.Open (FName) ' Modified line ***
The old statement runs the function again. FName is the variable given to the file in question.
ASKER
Sorry for my tardy reply. Thank you. It works perfectly now. I see all experts had the same answer.
pls try
Open in new window
Regards