Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 53
  • Last Modified:

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...

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

Open in new window



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

Open in new window

EE_fileDialog.accdb
Import_FC.xlsm
0
pdvsa
Asked:
pdvsa
1 Solution
 
John TsioumprisSoftware & Systems EngineerCommented:
Fname get the desired Excel...but again you want to get the Excel here
  xl.Workbooks.Open (getFileName()) ' Modified line ***

Open in new window

you should change it to
  xl.Workbooks.Open (FNAME) ' Modified line ***

Open in new window

1
 
Rgonzo1971Commented:
Hi,

pls try

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 (FName ) ' 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

Open in new window

Regards
0
 
hnasrCommented:
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.
0
 
pdvsaProject financeAuthor Commented:
Sorry for my tardy reply.  Thank you.  It works perfectly now.  I see all experts had the same answer.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now