Solved

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

Posted on 2016-11-11
4
27 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
4 Comments
 
LVL 13

Accepted Solution

by:
John Tsioumpris earned 500 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 48

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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

It took me quite some time to sort out all the different properties of combo and list boxes available from Visual Basic at run-time. Not that the documentation is lacking: the help pages are quite thorough and well written. The problem was rather wh…
Today's users almost expect this to happen in all search boxes. After all, if their favourite search engine juggles with tens of thousand keywords while they type, and suggests matching phrases on the fly, why shouldn't they expect the same from you…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…

744 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now