Dear All,
I have a shared Access Database Splitted, 3 years without an issue, and this morning the following VB code give the error shown below (sorry it is in italian, no idea how is in english):
Partial Code:
Private Sub IMPORT_PIR_BUTT_Click()
Dim rstIssues As DAO.Recordset
Dim sExcelFile As String
Dim fDialog As Object
Dim varFile As Variant
' Set up the File Dialog.
Set fDialog = Application.FileDialog(3)
With fDialog
' Do not allow user to make multiple selections in dialog box
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select your Excel File"
.InitialFileName = "H:\Operations\QUALITY\PIR\ISPEZIONI\"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
'.Filters.Add "Excel Files", "*.xls"
'.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varFile In .SelectedItems
sExcelFile = varFile
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
Exit Sub
End If
End With
'Field COORDINATE
'CODICE RIPARATORE ISSUES!B8
'NOME RIPARATORE ISSUES!E8
'CITTA ISSUES!B10
'COMPILATO DA ISSUES!B12
'Data ISSUES!G12
'PN ISSUES!B16
'DESCRIZIONE ISSUES!F16
'MODELLO ISSUES!B18
'VIN ISSUES!F18
'DATA CODE ISSUES!B20
'DATA ACQUISTO ISSUES!F20
'first empty the table
'CurrentDb.Execute "DELETE * FROM tmpDataList;", dbFailOnError
'now import the file
Set rstIssues = CurrentDb.TableDefs("tmpDataList").OpenRecordset
On Error Resume Next
Dim oApp As Excel.Application
Dim oWT As Excel.Workbook
Dim oWS As Excel.Worksheet
Application.Echo False
Set oApp = GetObject("Excel.Application")
If Err.Number <> 0 Then Set oApp = CreateObject("Excel.Application")
With oApp
.Visible = False
.Workbooks.Open (sExcelFile)
Set oWT = .ActiveWorkbook
Set oWS = oWT.Worksheets("RICHIESTA_DI ISPEZIONE")
'lets add the values
rstIssues.AddNew
rstIssues("[CODICE RIPARATORE]") = oWS.Range("B4")
rstIssues("[NOME RIPARATORE]") = oWS.Range("E4")
rstIssues("[CITTA]") = oWS.Range("B6")
rstIssues("[COMPILATO DA]") = oWS.Range("B8")
rstIssues("[DATA]") = oWS.Range("G8")
rstIssues("[PN]") = oWS.Range("B12")
rstIssues("[DESCRIZIONE]") = oWS.Range("F12")
rstIssues("[MODELLO]") = oWS.Range("B14")
rstIssues("[VIN]") = oWS.Range("F14")
rstIssues("[DATA CODE]") = oWS.Range("B16")
rstIssues("[DATA ACQUISTO]") = oWS.Range("F16")
rstIssues("[COMMENT]") = oWS.Range("A19")
rstIssues("[ORDINE_VOR]") = oWS.Range("H24")
rstIssues("[ORDINE_STOCK]") = oWS.Range("C24")
rstIssues.Update
End With
oWT.Close
oApp.Quit
Set oApp = Nothing
Application.Echo True
MsgBox "Import Complete!"
Shell ("H:\Operations\QUALITY\PIR\Dir_File\MOVE.BAT")
DoCmd.Close
DoCmd.OpenForm "TEMP_FORM"
End Sub
I have a shared Access Database Splitted, 3 years without an issue, and this morning the following VB code give the error shown below (sorry it is in italian, no idea how is in english):
Partial Code:
Private Sub IMPORT_PIR_BUTT_Click()
Dim rstIssues As DAO.Recordset
Dim sExcelFile As String
Dim fDialog As Object
Dim varFile As Variant
' Set up the File Dialog.
Set fDialog = Application.FileDialog(3)
With fDialog
' Do not allow user to make multiple selections in dialog box
.AllowMultiSelect = False
' Set the title of the dialog box.
.Title = "Please select your Excel File"
.InitialFileName = "H:\Operations\QUALITY\PIR\ISPEZIONI\"
' Clear out the current filters, and add our own.
.Filters.Clear
.Filters.Add "Excel Files", "*.xlsx"
'.Filters.Add "Excel Files", "*.xls"
'.Filters.Add "All Files", "*.*"
' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varFile In .SelectedItems
sExcelFile = varFile
Next
Else
MsgBox "You clicked Cancel in the file dialog box."
Exit Sub
End If
End With
'Field COORDINATE
'CODICE RIPARATORE ISSUES!B8
'NOME RIPARATORE ISSUES!E8
'CITTA ISSUES!B10
'COMPILATO DA ISSUES!B12
'Data ISSUES!G12
'PN ISSUES!B16
'DESCRIZIONE ISSUES!F16
'MODELLO ISSUES!B18
'VIN ISSUES!F18
'DATA CODE ISSUES!B20
'DATA ACQUISTO ISSUES!F20
'first empty the table
'CurrentDb.Execute "DELETE * FROM tmpDataList;", dbFailOnError
'now import the file
Set rstIssues = CurrentDb.TableDefs("tmpDataList").OpenRecordset
On Error Resume Next
Dim oApp As Excel.Application
Dim oWT As Excel.Workbook
Dim oWS As Excel.Worksheet
Application.Echo False
Set oApp = GetObject("Excel.Application")
If Err.Number <> 0 Then Set oApp = CreateObject("Excel.Application")
With oApp
.Visible = False
.Workbooks.Open (sExcelFile)
Set oWT = .ActiveWorkbook
Set oWS = oWT.Worksheets("RICHIESTA_DI ISPEZIONE")
'lets add the values
rstIssues.AddNew
rstIssues("[CODICE RIPARATORE]") = oWS.Range("B4")
rstIssues("[NOME RIPARATORE]") = oWS.Range("E4")
rstIssues("[CITTA]") = oWS.Range("B6")
rstIssues("[COMPILATO DA]") = oWS.Range("B8")
rstIssues("[DATA]") = oWS.Range("G8")
rstIssues("[PN]") = oWS.Range("B12")
rstIssues("[DESCRIZIONE]") = oWS.Range("F12")
rstIssues("[MODELLO]") = oWS.Range("B14")
rstIssues("[VIN]") = oWS.Range("F14")
rstIssues("[DATA CODE]") = oWS.Range("B16")
rstIssues("[DATA ACQUISTO]") = oWS.Range("F16")
rstIssues("[COMMENT]") = oWS.Range("A19")
rstIssues("[ORDINE_VOR]") = oWS.Range("H24")
rstIssues("[ORDINE_STOCK]") = oWS.Range("C24")
rstIssues.Update
End With
oWT.Close
oApp.Quit
Set oApp = Nothing
Application.Echo True
MsgBox "Import Complete!"
Shell ("H:\Operations\QUALITY\PIR\Dir_File\MOVE.BAT")
DoCmd.Close
DoCmd.OpenForm "TEMP_FORM"
End Sub