Solved

Allow user to choose the file to import

Posted on 2016-11-05
15
54 Views
Last Modified: 2016-11-11
Experts,

How would I be able to allow a user to choose the file to open instead of hard coding the name of the file as shown in the following line:
            xl.Workbooks.Open ("C:\Users\pdvsa\Desktop\Import_FC.xlsm")

thank you
Private Sub cmdImport_Click()

 DoCmd.OpenQuery "qryAppend_ImportFC"   'appends to an archive
 
         Dim strName As String
         Dim xl As Object
            Set xl = CreateObject("Excel.Application")
            xl.Workbooks.Open ("C:\Users\pdvsa\Desktop\Import_FC.xlsm")
            xl.Run "Transpose2"
            xl.ActiveWorkbook.Close (True)
            xl.Quit
            Set xl = Nothing
            CurrentDb.Execute "delete * from [Import_FC]"
            strName = "Transpose"

End Sub

Open in new window

0
Comment
Question by:pdvsa
  • 7
  • 6
  • 2
15 Comments
 
LVL 33

Expert Comment

by:Norie
ID: 41875616
Try this.
Private Sub cmdImport_Click()
Dim xl As Object
Dim strName As String
Dim strImportFilename As String

    DoCmd.OpenQuery "qryAppend_ImportFC"   'appends to an archive

    strImportFilename = PickFile

    If strImportFilename <> "" Then
        Set xl = CreateObject("Excel.Application")
        xl.Workbooks.Open strImportFilename
        xl.Run "Transpose2"
        xl.ActiveWorkbook.Close (True)
        xl.Quit
        Set xl = Nothing
        CurrentDb.Execute "delete * from [Import_FC]"
        strName = "Transpose"
    Else
        MsgBox "No file picked."
    End If

End Sub

Function PickFile() As String
Dim fDialog As Object
Dim varFile As Variant

    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)

    With fDialog

        .AllowMultiSelect = False
        .Title = "Please select a workbook to import"
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*"

        If .Show = True Then

            varFile = .SelectedItems(1)
        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
        
    End With

    If varFile <> "" Then
        PickFile = varFile
    End If
    
End Function

Open in new window

0
 

Author Comment

by:pdvsa
ID: 41875624
Thank you Norie.  I will try it when at a computer...typing from phone.  Appreciate the response.
0
 
LVL 30

Accepted Solution

by:
hnasr earned 500 total points
ID: 41875629
Try this,
Use Function FName;
Add this Private function in the form module.
   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


Modify your code:
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 ***

 DoCmd.OpenQuery "qryAppend_ImportFC"   'appends to an archive
 
         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
            CurrentDb.Execute "delete * from [Import_FC]"
            strName = "Transpose"

End Sub

Open in new window

0
The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

 
LVL 30

Expert Comment

by:hnasr
ID: 41875933
The top function helps to find the file name to open.

The sub is your sub modified, to call the function returning the name getFileName.
you put getFileName in place of the actual path of the file name.
0
 

Author Comment

by:pdvsa
ID: 41875931
Norie:
It says "Variable not defined" and highlights:
Function PickFile() As String

hnasr:
What shall I use for the top row?  Not sure how to explain but I think its the Function line.  I think its missing.
0
 

Author Closing Comment

by:pdvsa
ID: 41876178
hnasr:  works great!  I modified the top line to add the function Function getFileName() As String.

it does seem to select the file 2x though but I can live with that.
0
 
LVL 30

Expert Comment

by:hnasr
ID: 41876203
Sorry, forgot to comment unneeded statements in sub, these were moved to function.
Private Function getFileName()
   Dim fDialog As office.fileDialog
   Dim varFile As Variant
   Set fDialog = Application.fileDialog(msoFileDialogFilePicker)

    With fDialog
      .Title = "Please select one or more files"
       .Filters.add "Access Databases", "*.xls"
      .Filters.add "Access Projects", "*.xlsm"
      .Filters.add "All Files", "*.*"

      If .Show = True Then
        getFileName = .SelectedItems(1)
      Else
         getFileName = ""
      End If
   End With
End Function

Private Sub fileDialog_Click()
Dim FName As String
FName = getFileName()
If FName = "" Then
    MsgBox "You clicked Cancel in the file dialog box."
    Exit Sub
End If
    Dim xl As Object
            Set xl = CreateObject("Excel.Application")
            xl.Workbooks.Open FName ' Modified line =========================
            xl.Visible = True
'f = getFileName()
   'Dim fDialog As office.fileDialog
   'Dim varFile As Variant
   'Set fDialog = Application.fileDialog(msoFileDialogFilePicker)

    'With fDialog
      '.Title = "Please select one or more files"
       '.Filters.add "Access Databases", "*.MDB"
      '.Filters.add "Access Projects", "*.accrd"
      '.Filters.add "All Files", "*.*"

      If FName = "" Then
         MsgBox "You clicked Cancel in the file dialog box."
      End If
   'End With
End Sub

Open in new window

0
 

Author Comment

by:pdvsa
ID: 41876279
hnasr,

thank you for the changes made.  I have followed howeverit still loops through the file selection 2x.  Let me know what is the next step.
0
 
LVL 33

Expert Comment

by:Norie
ID: 41876433
pdvsa

How exactly did you use the code I posted?

I've tested it multiple times and have never had the problem you describe occur.

PS Do you want the user to select one file or multiple files? The code I posted only allows the user to select one file, just saying.:)
0
 
LVL 30

Expert Comment

by:hnasr
ID: 41876454
Sorry again, here is a sample database.
It is always very helpful to send a sample database. It takes less time and effort to resolve issues.
fileDialog.accdb
0
 

Author Comment

by:pdvsa
ID: 41876575
Hello Hnasr, sorry for the confusion.  

In the db attached, I do not see the docmd transfer spreadsheet code and append.  

Let me copy here what I have.  Maybe it will be more clear hopefully.  Possibly the placement of the append and docmdtransferspreadsheet is not correct.  

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

0
 

Author Comment

by:pdvsa
ID: 41883323
Hi Hnasr,

Just checking in.  Not sure if you read my comment above.  

thank you.  talk to you soon.
0
 
LVL 30

Expert Comment

by:hnasr
ID: 41883394
I commented n response to prompt for file name to import from.

If you need to integrate it in other code, that will be another requirement.

Uploading the file that has Form1 and Copy Of Form1 which includes old code.

To expand on this, you may open a new thread, upload the file and explain the requirement.
fileDialog.accdb
0
 

Author Comment

by:pdvsa
ID: 41883454
0
 
LVL 30

Expert Comment

by:hnasr
ID: 41883474
Please don't forget to upload a sample database, showing what is working and explain any extra requirement.
0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Question has a verified solution.

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

In the previous article, Using a Critera Form to Filter Records (http://www.experts-exchange.com/A_6069.html), the form was basically a data container storing user input, which queries and other database objects could read. The form had to remain op…
QuickBooks® has a great invoice interface that we were happy with for a while but that changed in 2001 through no fault of Intuit®. Our industry's unit names are dictated by RUS: the Rural Utilities Services division of USDA. Contracts contain un…
Familiarize people with the process of utilizing SQL Server functions from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Ac…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…

786 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