1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Excel Macro - VBA code to import access data to excel

Discussion in 'Business Applications' started by RanjiniJoseph, Jul 13, 2009.

Thread Status:
Not open for further replies.
  1. RanjiniJoseph

    RanjiniJoseph Thread Starter

    Joined:
    Jul 13, 2009
    Messages:
    1
    I'm working on a Bill of Material creation automation project that requires some expertise in VBA, and I have none.
    The objective is to run a macro from an excel spreadsheet called "PGE BOM", to do the following:
    1) Go to the folder "C:\Documents and Settings\Desktop\Auto Project"
    2) Find all the .mdb databases in this folder
    3) Find "HistoricalMaterialItemsAll" table in EACH of those databases in step 2, and import the data from the columns listed below into PGE BOM.xls's columns C through G:
    DrawingNumber
    ItemNumber
    Quantity
    PgeCode
    Description
    The following is a VBA code that my friend had written in Excel 2007. Unfortunately I have an older version (2000) and the code does not seem to be compatible with Excel 2000.
    Sub ImportAccessData()
    Stop
    dPath = "C:\Documents and Settings\Desktop\Auto Project\"
    sFile = "*.MDB"
    strSrch = dPath & sFile
    Set TargetWB = Application.ActiveWorkbook
    Set TargetWS = TargetWB.ActiveSheet
    sRow = 2
    bFile = False
    If Dir(strSrch) <> "" Then
    strFlNm = Dir(strSrch)
    bFile = True
    End If
    Do Until bFile = False
    strPath = dPath & strFlNm
    Call GetData(strPath)
    strFlNm = Dir
    If strFlNm = "" Then bFile = False
    Loop
    End Sub
    Sub GetData(fl)
    Stop
    strSQL = "Select HistoricalMaterialItemsAll.* From HistoricalMaterialItemsAll"
    Workbooks.OpenDatabase fl, strSQL, xlCmdTable
    Set WB = Application.ActiveWorkbook
    Set WS = Application.ActiveSheet
    iRow = 2
    Do Until WS.Cells(iRow, 1) = ""
    TargetWS.Cells(sRow, 7) = WS.Cells(iRow, 5) 'Get the Description
    iRow = iRow + 1
    sRow = sRow + 1
    Loop
    Application.DisplayAlerts = False
    WB.Close
    Application.DisplayAlerts = True
    End Sub
    The "ImportAcessData" sub procedure above works just fine. However, the red statement "Workbooks.OpenDatabase fl, strSQL, xlCmdTable" line in the "GetData" sub procedure seems to be incompatible with excel 2000. Could someone please help debug this?? Thanks!
     
  2. Zack Barresse

    Zack Barresse

    Joined:
    Jul 25, 2004
    Messages:
    5,452
    Hello, and welcome to the board!

    When posting code, please use CODE tags, which extremely helps with readability.

    Perhaps you could try using the code constant???...

    Code:
    Option Explicit
    
    Sub ImportAccessData()
        Dim dPath As String, sFile As String, strSrch As String
        Dim TargetWB As Workbook, TargetWS As Worksheet
        Dim sRow As Long, bFile As Boolean, strFlNm As String, strPath As String
        dPath = "C:\Documents and Settings\Desktop\Auto Project\"
        sFile = "*.MDB"
        strSrch = dPath & sFile
        sRow = 2
        bFile = False
        Set TargetWB = Application.ActiveWorkbook
        Set TargetWS = TargetWB.ActiveSheet
        If Dir(strSrch) <> "" Then
            strFlNm = Dir(strSrch)
            bFile = True
        End If
        Do Until bFile = False
            strPath = dPath & strFlNm
            Call GetData(strPath, TargetWB, TargetWS)
            strFlNm = Dir()
            If strFlNm = "" Then bFile = False
        Loop
    End Sub
    
    Sub GetData(fl As String, WB As Workbook, ws As Worksheet)
        Dim strSQL As String, iRow As Long, sRow As Long
        strSQL = "SELECT HistoricalMaterialItemsAll.* FROM HistoricalMaterialItemsAll"
        Workbooks.OpenDatabase fl, strSQL, 3 'xlCmdTable
        iRow = 2
        Do Until ws.Cells(iRow, 1) = ""
            ws.Cells(sRow, 7) = ws.Cells(iRow, 5) 'Get the Description
            iRow = iRow + 1
            sRow = sRow + 1
        Loop
        Application.DisplayAlerts = False
        WB.Close
        Application.DisplayAlerts = True
    End Sub
    
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Loading...
Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/842885

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice