Link to home
Start Free TrialLog in
Avatar of fatalblitz

asked on

Formatting Excel columns before importing to Access using VBA

I currently have VBA code that imports multiple .xls files located in a single folder into my Microsoft Access database. Before doing so, there is a portion of code that prepares the excel files (changes column names to match field names within database, searches for date columns equaling '00/00/000' and "None" values and changes them to blank " ". This is further noted in the code's comments down below. However, the code doesn't seem to work 100% and we still have to manually go back into the .xls files and do a find and replace for these Date columns that have "00/00/0000" and "None" values and replace with " ". Any suggestions as to how to update this code to remove this manual step? (highlighted in bold) Thanks

'This will prepare the excel files before importing to the database
'It will change the column names to match the field names within the database
'It will also search through the Dates columns for values such as '00/00/0000', "None" so
'that the files will import correctly
Public Function UpdateAndImport(filePath As String, file As String, workItem As Integer)
 '   Late Binding (Needs no reference set)
    Dim oXL As Object
    Dim oExcel As Object
    Dim sFullPath As String
    Dim sPath As String
    Dim TableToImport As String    'Table name within Access Database
    Dim xWs As String   'This will hold the name for the excel worksheet
    Dim xWs2 As String  'This will hold the name for the excel worksheet
    Dim upDatei As Long 'This is used in the system status progress bar
    Dim SysProg As String 'This is used in the system status bar as the message
    upDatei = 0
    'Variables used within: FIX WORKBOOK CONTENTS
        Dim count As Integer
        Dim SColumn As Integer
        Dim Scolumn2 As String
        Dim LastRow As Integer
        Dim ColumnName As String
        Dim x As Integer
        Dim i As Integer
    xWs = "Format"    'Worksheet name for import
    xWs2 = "Sheet1"   'The Data Entry Dates have the worksheet name as Sheet1
    ' Create a new Excel instance
    Set oXL = CreateObject("Excel.Application")
    ' Only XL 97 supports UserControl Property
    On Error Resume Next
    oXL.UserControl = True
    On Error GoTo 0
    ' Full path of excel file to open
    sFullPath = filePath & file
    'When Visible is true it will show the excel program.  Uncomment this for testing
    'oXL.Visible = True
     On Error GoTo ErrHandle
    'This will open the file
    oXL.workbooks.Open (sFullPath)
    Dim objworkbook As Object
    Set objworkbook = oXL.Application.ActiveWorkbook
    'Update Status in text
    [Forms]![Form: Skill Area Selection]![MsgTxt] = "Editing File: " & file
    SysProg = SysCmd(acSysCmdInitMeter, "Editing File: " & file, upDatei)
    'Change workbook column headings depending on which worksheet it is
    'This will set the names of the database table
    If workItem = 1 Then
        TableToImport = "Qualifications Overview"
        DoCmd.OpenForm "FieldInfo", acDesign, , , acFormPropertySettings, acHidden
        'The following lines will change the worksheet field headers (The individual column names)
        objworkbook.worksheets(xWs).range("A1") = [Forms]![FieldInfo]![Text0].DefaultValue
        objworkbook.worksheets(xWs).range("B1") = [Forms]![FieldInfo]![Text6].DefaultValue
        objworkbook.worksheets(xWs).range("C1") = [Forms]![FieldInfo]![Text8].DefaultValue
        objworkbook.worksheets(xWs).range("D1") = [Forms]![FieldInfo]![Text10].DefaultValue
        objworkbook.worksheets(xWs).range("E1") = [Forms]![FieldInfo]![Text12].DefaultValue
        objworkbook.worksheets(xWs).range("F1") = [Forms]![FieldInfo]![Text14].DefaultValue
        objworkbook.worksheets(xWs).range("G1") = [Forms]![FieldInfo]![Text19].DefaultValue
        objworkbook.worksheets(xWs).range("H1") = [Forms]![FieldInfo]![Text21].DefaultValue
        objworkbook.worksheets(xWs).range("I1") = [Forms]![FieldInfo]![Text23].DefaultValue
        objworkbook.worksheets(xWs).range("J1") = [Forms]![FieldInfo]![Text25].DefaultValue
        objworkbook.worksheets(xWs).range("K1") = [Forms]![FieldInfo]![Text27].DefaultValue
        DoCmd.Close acForm, "FieldInfo"
        'This will fix the workbook contents ie. the '00/00/000' , 'none' within this workbook

        i = 1
        ColumnName = "Qualification End Date"
        LastRow = objworkbook.worksheets(
        Do While i <= 3
            'The x within this do while loop is used to go through each column to find the string within the
            'following column name: Qualification End Date, Qualification Start date, and
            'Qualification Changed Date
            x = 1
            Do While x <= objworkbook.worksheets(
                'SColumn = oXL.Application.worksheetfunction.match(ColumnName, objworkbook.worksheet.range(ColumnNumbToLet(x) & "1:" & ColumnNumbToLet(x)"1" & LastRow), 0)
                On Error Resume Next
                'This looks at the current heading (first row) and if it does not matches any of the
                'Column names it will add 1 to x to search for the next column
                If objworkbook.worksheets( & "1").Value <> ColumnName Then
                    x = x + 1
                'If the column name does match process the following
                    SColumn = x  'This is the column number for the found column name
                        'Excel Find function could not work
                        'With Sheets("A1:K11")
                        'SColumn = Range("A1:K100").Find(ColumnName, Range("A1"), xlValues, xlWhole, xlByColumns, xlNext).Column
                        'End With
                        'This will go through all cells within the found column to change any
                        'cells that have the value: '00/00/0000' or 'None'
                        count = 1
                        'This will convert the number column to a letter column
                        Scolumn2 = ColumnNumbToLet(SColumn)
                        Do While count <= LastRow
                            If objworkbook.worksheets( & count).Value = "00/00/0000" Then
                               objworkbook.worksheets( & count).Value = ""
                            ElseIf objworkbook.worksheets( & count).Value = "None" Then
                                objworkbook.worksheets( & count).Value = ""
                            End If
                            count = count + 1
                x = x + 1
                End If
            Loop 'End loop for x
        'Search for the next column for the belowed strings
        ColumnName = "Qualification Changed Date"
        If i = 2 Then ColumnName = "Qualification Start Date"
        i = i + 1
        'END of fix for 00/00/00 and 'none'
Avatar of Markus Fischer
Markus Fischer
Flag of Switzerland image

I must admit: I haven't examined your code in detail to understand what it does. Some used functions are not included and the syntax seems needlessly convoluted, for example:


can be replaced by


Incidentally, your code would also become more readable using the With construct or object variables for sheets and ranges.

If your aim is simply to find and replace all occurrences of “00/00/0000” and “None”, the following might suffice:

    Dim rngC As Range
    For Each rngC In objworkbook.ActiveSheet.UsedRange.Cells
        If rngC = "00/00/0000" Then
            rngC = Empty
        ElseIf rngC = "None" Then
            rngC = Empty
        End If
    Next rngC

Open in new window

I hope this helps
Avatar of fatalblitz


Would I have to comment out or remove the current do while / count code before adding your portion of the code? Sorry my coding knowledge in VBA is fairly basic, I get a compile error: User-defined type not defined and it points to the:

Dim rngC As Range
Avatar of aikimark

The harfang code assumes you have a reference to Microsoft Excel in your Access code.  That is why "Range" is an unknown data type.
Avatar of Markus Fischer
Markus Fischer
Flag of Switzerland image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Okay thanks, I will try this and post back the results!