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