Results 1 to 8 of 8
  1. #1
    Join Date
    Jan 2008
    Posts
    74

    Unanswered: Excel Access Import - how can I improve VBA code?

    Hello all!

    I searched the Internet and this forum for a similar problem, but I found no help... Also, I'm a complete newbie to the fascinating world of programming, VBA and Access, so my question can very well be very stupid.

    The tasks are:

    1)Import an Excel table into Access
    2)Add a new column and fill it with variables of date/time type.

    Steps 1 and 2 need to be done only once, and I've almost managed to accomplish them. Now comes the hack:

    3)This imported table needs to be updated daily... In other words, it will grow with every day.

    I created a FileDialog object where I can choose the Excel file to import. First, the programme checks whether the requested Access table already exists and if it doesn't, the code does a simple TransferSpreadsheet. If the table exists, I tried to make an append query to "glue" the Excel table records - that's where I failed completely and miserably.

    Here's a code snippet from what I have so far:

    Edit: I've succeeded in creating a working code, but it is VERY clumsy. I posted it at the end of the thread. Any hints to improve it? Please?

    Code:
        Dim ADODBConnection As New ADODB.Connection
        Dim ADORS As New ADODB.Recordset
        Dim fd As FileDialog
        Dim arNames As Variant
        Dim strMonat As String
        Dim NewColumn As Object
        Dim curDatabase As Object
        Dim tblImported As Object
        Dim tblImported1 As Object
        Dim strSQL As String
        Dim sFileName As String
        Dim objTable As TableDef
            
        
    
        'Calls the dialog window
        Set fd = Application.FileDialog(msoFileDialogFilePicker)
           
            
        With fd
            .AllowMultiSelect = True
            .Filters.Clear
            .Filters.Add "Excel", "*.xls"
            If .Show = -1 Then
                'runs throught selected files
                For Each vrtSelectedItem In .SelectedItems
                
                    'checks whether the table already exists
                    Set objTable = CurrentDb.TableDefs("Blublu")
                    
                    'if it doesn't, import it
                    If objTable Is Nothing Then
                                    
                       DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Blublu", vrtSelectedItem, False, "Tabelle1!A1:D45"
                    
                                  
                         'inserts a new column
    
                       Set curDatabase = CurrentDb        
                       Set tblImported = curDatabase.TableDefs("Blublu")
                       Set NewColumn = tblImported.CreateField("Monat", DB_TEXT)
                       tblImported.Fields.Append NewColumn
                   
               
                         'and fills it depending on a selected Excel table
    
                       sFileName = Mid(Dir(vrtSelectedItem), 9, 6)
                     
                       If sFileName Like "I*" Then
                     
                           strSQL = "UPDATE Blublu SET [Monat]= #31.12.2008# ;"
                           'strSQL doesn't work: the compiler discovered a syntax error, which is a complete mystery to me
                           DoCmd.RunSQL strSQL
                      
                       ElseIf sFileName Like "E*" Then
                            DoCmd.RunSQL "UPDATE Blublu SET Blublu.Monat = #31.2008# ;"
                        
                       Else
                            MsgBox "The file" & sFileName & " doesn't exist."
                        
                       End If
                       
                 'if the table already exists, append the records from Excel to it:
    
               Else
                      
                       DoCmd.RunSQL "INSERT INTO Blublu" & _
                                     "SELECT *." & vrtSelectedItem & "FROM" & vrtSelectedItem & ";"
                                     
                 End If
    Any help would be greatly appreciated!

    Thanks a lot in advance,
    OfficeDummy
    Last edited by OfficeDummy; 01-11-08 at 05:54.

  2. #2
    Join Date
    Aug 2006
    Posts
    559
    I'm going to try to look into it but I know a book of "Integrating MS Excel with MS Access" would really help you out.

  3. #3
    Join Date
    Feb 2004
    Posts
    137
    Try changing:
    Code:
    DoCmd.RunSQL "INSERT INTO Blublu" & _
        "SELECT *." & vrtSelectedItem & "FROM" & vrtSelectedItem & ";"
    ...to
    Code:
    CurrentDb.Execute "INSERT INTO Blublu" _
        & " SELECT *" _
        & " FROM [Excel 5.0;HDR=YES;IMEX=2;DATABASE=" _
        & vrtSelectedItem & "].Blublu"

  4. #4
    Join Date
    Jan 2008
    Posts
    74
    Thanks, Mattew!

    But unfortunately, there seems to be a mistake at the very beginning where I'm checking whether the table exists or not. So I can't even check your version... I get eror 3075 and the compiler says, that it can't find the element in the list.

    Any ideas? Please? I'm really desperate here.

  5. #5
    Join Date
    Feb 2004
    Posts
    137
    You will need to trap the error by revising your code thus:
    Code:
    On Error Resume Next
    Set objTable = CurrentDb.TableDefs("Blublu")
    On Error Goto 0

  6. #6
    Join Date
    Jan 2007
    Location
    UK
    Posts
    11,434
    Provided Answers: 10
    I suggest 2 different methods

    1) enumerate through tabledefs collection checking each tables name
    2) open arecordset using the following SQL
    Code:
    SELECT 1
    FROM   MSysObjects
    WHERE  type=1
    AND    name = <your table name>
    If there is a returned value, then the table exists.
    George
    Home | Blog

  7. #7
    Join Date
    Jan 2008
    Posts
    74
    Thanks so much, georgev and Matthew!

    I solved the problem, but my code is really long and clumsy - could someone please suggest any way to improve it?

    Some background information: 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.

    Thanks you so much in advance for your help!!!!

    Code:
    Private Sub cmdImport_Click()
    
    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 next part follows in a separate post...

  8. #8
    Join Date
    Jan 2008
    Posts
    74
    And now the same for the second worksheet:

    Code:
                  
                  'now import the second worksheet: the same operation
                  'first check if the table has already been imported
                  
                  If Existence("IT") = True Then
                  
                      'if it's there, then
                      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                                                "Vremenno", vrtSelectedItem, False, "IT!A1:Z20000"
                                                                  
                      'insert a new column to the temporary table
                      Set curDatabase = CurrentDb
                      
                      Set tblImported1 = curDatabase.TableDefs("Vremenno")
                      Set NewColumn1 = tblImported1.CreateField("Monat", DB_DATE)
                      tblImported1.Fields.Append NewColumn1
                                                
                      '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
                     
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '31.10.2007' ;"
                        DoCmd.RunSQL strSQL1
                      
                      ElseIf sFileName Like "N*" Then
                        DoCmd.RunSQL "UPDATE Vremenno SET Vremenno.Monat = ' 30.11.2007 ';"
                        
                      ElseIf sFileName Like "D*" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '31.12.2007' ;"
                        DoCmd.RunSQL strSQL1
                        
                      ElseIf sFileName Like "Ja*" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '31.01.2008' ;"
                        DoCmd.RunSQL strSQL1
                        
                      ElseIf sFileName Like "F*" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '28.02.2008' ;"
                        DoCmd.RunSQL strSQL1
                        
                      ElseIf sFileName Like "Mä*" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '31.03.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Ap" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '30.04.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Mai" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '31.05.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Jun" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '30.06.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Jul*" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '31.03.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Aug" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '31.08.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Sep*" Then
                        strSQL1 = "UPDATE Vremenno SET [Monat]= '30.09.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      Else
                        MsgBox "Datei IT-IS Verrechnung " & sFileName & " existiert nicht."
                        
                      End If
                      
                      'now append the temporary table to the existing IS table
                      
                      strSQL1 = "INSERT INTO IT" _
                                         & " SELECT Vremenno.* FROM Vremenno;"
                      DoCmd.RunSQL strSQL1
                      
                      'delete the temporary table
                      DoCmd.DeleteObject acTable, "Vremenno"
                      DoCmd.OpenTable "IT", acViewNormal, acReadOnly
                      
       
                  'if the table doesn't exist, create it
                  
                  Else
                      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
                                                "IT", vrtSelectedItem, False, "IT!A1:Z20000"
                      
                                                
                      'insert a new column
                      
                      Set curDatabase = CurrentDb
                      
                      Set tblImported3 = curDatabase.TableDefs("IT")
                      Set NewColumn3 = tblImported3.CreateField("Monat", DB_DATE)
                      tblImported3.Fields.Append NewColumn3
                      
                      'and fill it depending on which month has been selected to import
                      
                      sFileName = Mid(Dir(vrtSelectedItem), 19, 6)
                      
                      If sFileName Like "O*" Then
                     
                        strSQL1 = "UPDATE IT SET [Monat]= '31.10.2007' ;"
                        DoCmd.RunSQL strSQL1
                      
                      ElseIf sFileName Like "N*" Then
                        DoCmd.RunSQL "UPDATE IT SET IT.Monat = ' 30.11.2007 ';"
                        
                      ElseIf sFileName Like "D*" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '31.12.2007' ;"
                        DoCmd.RunSQL strSQL1
                        
                      ElseIf sFileName Like "Ja*" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '31.01.2008' ;"
                        DoCmd.RunSQL strSQL1
                        
                      ElseIf sFileName Like "F*" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '28.02.2008' ;"
                        DoCmd.RunSQL strSQL1
                        
                      ElseIf sFileName Like "Mä*" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '31.03.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Ap" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '30.04.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Mai" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '31.05.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Jun" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '30.06.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Jul*" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '31.03.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Aug" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '31.08.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      ElseIf sFileName Like "Sep*" Then
                        strSQL1 = "UPDATE IT SET [Monat]= '30.09.2008' ;"
                        DoCmd.RunSQL strSQL1
                        DoCmd.SetWarnings False
                        
                      Else
                        MsgBox "Datei IT-IS Verrechnung " & sFileName & " existiert nicht."
                        
                      End If
                     
                   DoCmd.OpenTable "IT", acViewNormal, acReadOnly
                  End If
                Next vrtSelectedItem
             End If
        End With
     
    End Sub
    Thanks again,
    OfficeDummy

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •