- Joined
- Jan 11, 2008
- Messages
- 3
- Reaction score
- 0
Hello, all!
I have Excel tables that are named "IT-IS Verrechnung [Monat] 2008" that need to be imported monthly. The tables are about IT costs of our enterprise - how much money was spent for various employees and on which cost center, etc - and I need to make a search form in Access based on them. For that, I have to insert a Month column so that I can calculate costs for a given period of time.
Excel file has two worksheets: IS and IT.
I have a working code, but it's very long and clumsy, so I'm afraid it might "break" easily. How can I optimise it???
Here's a snippet:
The second worksheet is being imported in a similar way, I've just created a different temporary table to store the records in.
Any help would be greatly appreciated!
Thanks a lot in advance,
DummiestDummy
I have Excel tables that are named "IT-IS Verrechnung [Monat] 2008" that need to be imported monthly. The tables are about IT costs of our enterprise - how much money was spent for various employees and on which cost center, etc - and I need to make a search form in Access based on them. For that, I have to insert a Month column so that I can calculate costs for a given period of time.
Excel file has two worksheets: IS and IT.
I have a working code, but it's very long and clumsy, so I'm afraid it might "break" easily. How can I optimise it???
Here's a snippet:
Code:
Private Sub cmdImport_Click()
Dim ADODBConnection As New ADODB.Connection
Dim ADORS As New ADODB.Recordset
Dim fd As FileDialog
Dim curDatabase As Object
Dim tblImported As Object
Dim tblImported1 As Object
Dim tblImported2 As Object
Dim tblImported3 As Object
Dim NewColumn As Object
Dim NewColumn1 As Object
Dim NewColumn2 As Object
Dim NewColumn3 As Object
Dim sFileName As String
Dim strSQL As String
Dim strSQL1 As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Excel", "*.xls"
If .Show = -1 Then
'Durchläuft die ausgewählten Dateien
For Each vrtSelectedItem In .SelectedItems
'checks whether the table exists
If Existence("IS") = True Then
'if it's there, then transport the Excel sheet into a temporary table
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"Temporary", vrtSelectedItem, False, "IS!A1:Z20000"
'insert a new column to the temporary table
Set curDatabase = CurrentDb
Set tblImported2 = curDatabase.TableDefs("Temporary")
Set NewColumn2 = tblImported2.CreateField("Monat", DB_DATE)
tblImported2.Fields.Append NewColumn2
'get the xls file name
sFileName = Mid(Dir(vrtSelectedItem), 19, 6)
'fill the inserted column dependant on the month chosen in xls
If sFileName Like "O*" Then
strSQL = "UPDATE Temporary SET [Monat]= '31.10.2007' ;"
DoCmd.RunSQL strSQL
ElseIf sFileName Like "N*" Then
DoCmd.RunSQL "UPDATE Temporary SET Temporary.Monat = ' 30.11.2007 ';"
ElseIf sFileName Like "D*" Then
strSQL = "UPDATE Temporary SET [Monat]= '31.12.2007' ;"
DoCmd.RunSQL strSQL
ElseIf sFileName Like "Ja*" Then
strSQL = "UPDATE Temporary SET [Monat]= '31.01.2008' ;"
DoCmd.RunSQL strSQL
ElseIf sFileName Like "F*" Then
strSQL = "UPDATE Temporary SET [Monat]= '28.02.2008' ;"
DoCmd.RunSQL strSQL
ElseIf sFileName Like "Mä*" Then
strSQL = "UPDATE Temporary SET [Monat]= '31.03.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Ap" Then
strSQL = "UPDATE Temporary SET [Monat]= '30.04.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Mai" Then
strSQL = "UPDATE Temporary SET [Monat]= '31.05.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Jun" Then
strSQL = "UPDATE Temporary SET [Monat]= '30.06.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Jul*" Then
strSQL = "UPDATE Temporary SET [Monat]= '31.03.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Aug" Then
strSQL = "UPDATE Temporary SET [Monat]= '31.08.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Sep*" Then
strSQL = "UPDATE Temporary SET [Monat]= '30.09.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
Else
MsgBox "Datei IT-IS Verrechnung " & sFileName & " existiert nicht."
End If
'now append the temporary table into the existing IS table
strSQL = "INSERT INTO IS" _
& " SELECT Temporary.* FROM Temporary;"
DoCmd.RunSQL strSQL
'delete the temporary table
DoCmd.DeleteObject acTable, "Temporary"
DoCmd.OpenTable "IS", acViewNormal, acReadOnly
'if the table doesn't exist, create it
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"IS", vrtSelectedItem, False, "IS!A1:Z20000"
'insert a new column
Set curDatabase = CurrentDb
Set tblImported = curDatabase.TableDefs("IS")
Set NewColumn = tblImported.CreateField("Monat", DB_DATE)
tblImported.Fields.Append NewColumn
'and fill it depending on which month has been selected to import
sFileName = Mid(Dir(vrtSelectedItem), 19, 6)
If sFileName Like "O*" Then
strSQL = "UPDATE IS SET [Monat]= '31.10.2007' ;"
DoCmd.RunSQL strSQL
ElseIf sFileName Like "N*" Then
DoCmd.RunSQL "UPDATE IS SET IS.Monat = ' 30.11.2007 ';"
ElseIf sFileName Like "D*" Then
strSQL = "UPDATE IS SET [Monat]= '31.12.2007' ;"
DoCmd.RunSQL strSQL
ElseIf sFileName Like "Ja*" Then
strSQL = "UPDATE IS SET [Monat]= '31.01.2008' ;"
DoCmd.RunSQL strSQL
ElseIf sFileName Like "F*" Then
strSQL = "UPDATE IS SET [Monat]= '28.02.2008' ;"
DoCmd.RunSQL strSQL
ElseIf sFileName Like "Mä*" Then
strSQL = "UPDATE IS SET [Monat]= '31.03.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Ap" Then
strSQL = "UPDATE IS SET [Monat]= '30.04.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Mai" Then
strSQL = "UPDATE IS SET [Monat]= '31.05.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Jun" Then
strSQL = "UPDATE IS SET [Monat]= '30.06.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Jul*" Then
strSQL = "UPDATE IS SET [Monat]= '31.03.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Aug" Then
strSQL = "UPDATE IS SET [Monat]= '31.08.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
ElseIf sFileName Like "Sep*" Then
strSQL = "UPDATE IS SET [Monat]= '30.09.2008' ;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings False
Else
MsgBox "Datei IT-IS Verrechnung " & sFileName & " existiert nicht."
End If
DoCmd.OpenTable "IS", acViewNormal, acReadOnly
End If
Any help would be greatly appreciated!
Thanks a lot in advance,
DummiestDummy