Excel Macro - VBA code to import access data to excel

Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

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!
 
Joined
Jul 25, 2004
Messages
5,458
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
 
Status
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

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 807,865 other people just like you!

Latest posts

Staff online

Top