Option Compare Database
Option Explicit
Public Sub XlfileImportTestNew()
Dim rs As New ADODB.Recordset
Dim conn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim filename As String
Dim rsIn As DAO.Recordset
Dim db As Database
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrksht As Excel.Worksheet
Dim xlRange As Excel.Range
'Dim colIdx As Integer
'Dim sFile As Variant
'Dim strPath As String
On Error GoTo XlfileImportTest_Error
'MsgBox "Please choose file to upload relevant Claim form", vbOKOnly, "Choose file to import relevant claim form" removed on the 13th September
MsgBox "Please upload Commission Claim Form", vbOKOnly, "Commission Claim Form"
filename = importFileName(".xlsm")
If Len(filename) = 0 Then
Exit Sub
End If
'Permit only excel files
If filename <> "" And Mid(filename, InStrRev(filename, ".") + 0, 5) <> ".xlsm" Then
'importCSV = False
MsgBox "Invalid filetype, only .xlsm files permitted", vbCritical, "Invalid File Type"
Exit Sub
End If
If filename <> "" Then 'And Mid(filename, InStrRev(filename, "\") + 1, 6) = "Mobile" Then
DoCmd.SetWarnings False
With conn
'.Provider = "Microsoft.Jet.OLEDB.4.0"
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source='" & filename & "'; " & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
.Open
End With
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdText
Select Case MsgBox("You are trying to import new claims data, This will delete the claims history.", vbYesNo Or vbExclamation Or vbDefaultButton1, "Do you agree?")
Case vbYes
DoCmd.RunSQL "delete * from tblConsolidatedClaimform", False
'Call PctMeter(25, 100)
Case vbNo
MsgBox ("Payments for Services not imported, exiting")
On Error GoTo 0
Exit Sub
End Select
cmd.CommandText = "SELECT * FROM [Claim Form$]"
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockReadOnly
rs.Open cmd
Set db = CurrentDb()
Set rsIn = db.OpenRecordset("select * from tblConsolidatedClaimform")
Set xlApp = CreateObject("Excel.Application")
[COLOR=yellow][COLOR=red]Set xlBook = xlApp.Workbooks.Open(filename)[/COLOR]
[/COLOR] Set xlWrksht = xlBook.Sheets("Claim Form")
Set xlRange = xlWrksht.Range("B23:J23")
Dim rr As Integer
rr = 2
Dim coll As Integer
coll = 23
With xlWrksht
While .Cells(coll, rr) <> ""
rsIn.AddNew
For rr = 2 To xlRange.Columns.Count
rsIn.Fields(rr + 5) = .Cells(coll, rr)
'good debug point
'Debug.Print .Cells(coll, rr)
Next rr
rsIn.Fields("Store_Code") = xlWrksht.Cells(5, "C")
rsIn.Fields("Premise_State") = xlWrksht.Cells(7, "C")
rsIn.Fields("Store_Name") = xlWrksht.Cells(9, "C")
rsIn.Fields("Email_Address") = xlWrksht.Cells(11, "C")
rsIn.Fields("Date_Emailed_to_Telstra") = xlWrksht.Cells(13, "C")
rsIn.Fields("Total_value_claim") = xlWrksht.Cells(5, "H")
rsIn.Fields("Original_Claim_Number") = xlWrksht.Cells(11, "I")
rsIn.update
coll = coll + 1
rr = 2
Wend
End With
Call Claims_File(filename)
'MsgBox "Records are succesfully imported", vbOKOnly, "Claim Form Import" removed on the 13th September 2013
MsgBox "Records are succesfully imported"
xlBook.Close (0)
xlApp.Quit
rs.Close
Set rs = Nothing
rsIn.Close
Set rsIn = Nothing
IncorrectFile:
On Error GoTo 0
Exit Sub
XlfileImportTest_Error:
'Newly added on the 11th of September 2013, in order to handle the error with the message 1004
'If Err.Number = 1004 Then
' MsgBox "Unable to continue due to incorrect filename, please try re-running the claims reconciliation process"
' Err.Clear
' Exit Sub
'Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure XlfileImportTest of Module Import"
'End If
End If
End Sub
That way anything goes wrong you can always go back to that copy.
