?
Solved

Allow user to choose the file to import (loops 2x)

Posted on 2016-11-11
4
Medium Priority
?
41 Views
Last Modified: 2016-11-11
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
Comment
Question by:pdvsa
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
4 Comments
 
LVL 18

Accepted Solution

by:
John Tsioumpris earned 2000 total points
ID: 41883470
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
 
LVL 52

Expert Comment

by:Rgonzo1971
ID: 41883476
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
 
LVL 30

Expert Comment

by:hnasr
ID: 41883498
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
 

Author Closing Comment

by:pdvsa
ID: 41884429
Sorry for my tardy reply.  Thank you.  It works perfectly now.  I see all experts had the same answer.
0

Featured Post

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Phishing attempts can come in all forms, shapes and sizes. No matter how familiar you think you are with them, always remember to take extra precaution when opening an email with attachments or links.
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Suggested Courses

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question