Double Click File Name Errors Import (1 Viewer)

[nstratton]

The code below is used to import an excel worksheet into a database on a daily basis. Everything works and the files are imported everytime when you click the button on the dialog box; however I would also like the option to double click the file name to import the data. I had this working when I working on this issue at home (using Access 2013) but I come into work today (using Access 2010) it no longer works and I receive an error "Excel cannot complete this task with available resources. Choose less data or close other applications" and Runtime Error 1004: Open Method of Workbooks Class failed.

Just tested again: Double clicked filename and it did import, try to run the code a second time (on a different file) and it failed. It is just weird that it is working off/on when it feels like it, but the button works every time.

Function GetFile()
'Declare a variable to contain FileDialog
Dim sMyPath As FileDialog
'Declare a variable to contain the path
Dim sPath As Variant
Dim strMessage As String
Dim strTitle As String
Dim strToday As String
Dim strSQL As String
Dim strSQL1 As String

Dim objXL As Object

Set objXL = CreateObject("Excel.Application")

strToday = Format(Date, "m-dd-yyyy")

strMessage = "You are about to bring new data into the database." & Chr(13) & Chr(10) & _
             "You will be asked to select a file to be imported." & Chr(13) & Chr(10) & _
             "Do you wish to continue?"
strTitle = "Import New Data"

intResponse = MsgBox(strMessage, vbYesNo + vbQuestion, strTitle)

If intResponse = vbYes Then

DoCmd.SetWarnings False
DoCmd.Hourglass True
' Set up the File Dialog.

Set sMyPath = Application.FileDialog(msoFileDialogFilePicker)

With sMyPath

' Allow users to not make multiple selections in dialog box
.AllowMultiSelect = False

'.InitialFileName = "C:\Users\cole.stratton\Documents\Procurement\Database Folders\Morning FTTQ\"

' Set the title of the dialog box.
.Title = "Select your File"

' Clear out the current filters, and add your own.
.Filters.Add "All Files", "*.*"

'Set the text of the button Caption
.ButtonName = "Get File"
    'Use the Show method to display the File Picker dialog box and return the user's action.
    'The user pressed the action button.
    If .Show Then
    For Each sPath In .SelectedItems
    Debug.Print sPath
        With objXL
            .Workbooks.Open (sPath)
            ProdDate = Mid(sPath, InStrRev(sPath, " ", -1), 11)
            .Sheets(1).Range("A1").Value = Replace(.Sheets(1).Range("A1").Value, ".", "")
            .Sheets(1).Range("D1").Value = Replace(.Sheets(1).Range("D1").Value, ".", "")
            .Sheets(1).Range("F1").Value = Replace(.Sheets(1).Range("F1").Value, ".", "")
            '.Sheets(1).Range("W2").Value = Replace(.Sheets(1).Range("W2").Value, "Other", .Sheets(1).Range("X2").Value)
            .ActiveWorkbook.Save
            .ActiveWorkbook.Close
            .Application.Quit
        End With
     MsgBox ProdDate
    'import into primary table
    'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tblRawData", sPath, True
    'DoCmd.OpenQuery "qryDeleteUnwantedInfo"
    'DoCmd.OpenQuery "qryMoveNoteToSupplier"
    'strSQL = "UPDATE tblRawData SET tblRawData.FileDate = '" & ProdDate & "' " _
             & "WHERE (((tblRawData.FileDate) Is Null));"

    'CurrentDb.Execute strSQL
    
Next sPath
MsgBox "File Add Success!", , "Success!"

   Else
    'Show if Canceled is selected in a message box
    sPath = "No File Selected to Import."
    MsgBox sPath
    End If

End With
DoCmd.SetWarnings True
DoCmd.Hourglass False
Else
MsgBox "You elected not to bring new data into the database", , strTitle
End If

End Function

 

[Ranman256]

The dbl-click works fine. This only works for 1 file.
It wont for multiple files.

 

[James Deckert]

You should be removing all of your objects from memory at the end of your function by
Set var = Nothing for each object which you did a Set on.
e.g.
Set sMyPath = Nothing
Set objXL = Nothing

 

[nstratton]

The dbl-click works fine. This only works for 1 file.
It wont for multiple files.

I understand I can't do it for multiple files. This issue was the code ran to completion and when I started the code again I received the error.

You should be removing all of your objects from memory at the end of your function by
Set var = Nothing for each object which you did a Set on.
e.g.
Set sMyPath = Nothing
Set objXL = Nothing

I will try adding these to the end of code and will report back with results. I'm going to assume it gets placed right about the [/CODE] End Function [/CODE] line and not inside any if/with statements

 

[nstratton]

Cleared the objects and it works like expected

 

[James Deckert]

You just need to put them where you're sure you're done with the objects, I usually put them at the end of the sub/function so that if there is an error, or I jump to the end of the function, I still clear the objects.