Excel Import via VBA - how can I improve my horrible code??

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:

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
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top