VB

Please help  

i have got a front end apps called data loader
what i want to do is to be able to include multiple table when importing , but at the moment it can only include one table when importing .could you please provide a sam ple code that can include more than two tables when importing .


I have a tab that i  normally click on to include , but when click on it and try to include a table , it does return dataset but if i try two tables it return nothing .please help me write a simple code that can allow two tables to return result in excel spreadsheet at once.

If i select all , it does return all table  but i want to be able to select more than one table as well

Enclose the code


'########################################################
'#                 Sub Import_DB - MACRO                #
'#                                                      #
'# Purpose : Imports the contents of one or more tables #
'#           of a database into the active spreadsheet  #
'# Receives: Nothing                                    #
'# Returns : Nothing                                    #
'########################################################

Sub Import_DB()
   
    Dim bSkipIt As Boolean
    Dim bWholeDB As Boolean
    Dim naDataTypes() As Integer
    Dim nCol As Integer
    Dim nColumn As Integer
    Dim nDataType As Integer
    Dim nExcelCol As Integer
    Dim nExcelRow As Long
    Dim nRecCount As Long
    Dim nRecord As Long
    Dim oRecColumns As Object
    Dim oRecDB As Object
    Dim oRecTables As Object
    Dim oSourceDB As Object
    Dim saColNames() As String
    Dim sCellAddress As String
    Dim sColNames As String
    Dim sDriver As String
    Dim sDSN As String
    Dim sFileName As String
    Dim sPassword As String
    Dim sSelect As String
    Dim sTableExcludePattern As String
    Dim sTableName As String
    Dim sTablePattern As String
    Dim sUser As String
    Dim sValue As String
    Dim vRecord As Variant

    'Open the import window
    Import_Form.Show
   
    If Import_Form.tbDSN.Text = "" Then    'User clicked Cancel
        End    'End application
    End If
   
    sDSN = UCase(Import_Form.tbDSN.Text)
    sDriver = Import_Form.tbDriver.Text
    sUser = Import_Form.tbUser.Text
    sPassword = Import_Form.tbPassword.Text
   
    Set oSourceDB = CreateObject("ADODB.Connection")
    Set oRecColumns = CreateObject("ADODB.Recordset")
    oRecColumns.CacheSize = 10
    Set oRecDB = CreateObject("ADODB.Recordset")
    oRecDB.CacheSize = 10
    Set oRecTables = CreateObject("ADODB.Recordset")
    oRecTables.CacheSize = 10

    'For mainframe, add alias to the connection string
    If sDriver Like "*DB2*" Then
        sDSN = sDSN & ";DBALIAS=" & sDSN
    End If

    nExcelRow = 2   'First row of data in the spreadsheet
   
    'Connect to source database
    Call ADO_Connect_DB(oSourceDB, sDSN, sUser, sPassword, Import_Form.tbDSNType.Text, False)

    sTableName = UCase(Import_Form.tbTable.Text)
    sTablePattern = sTableName
    sTableExcludePattern = UCase(Import_Form.tbExcludeTable.Text)

    'Based on driver, modify sDSN in preparation for OpenSchema
    If sDriver Like "*ORACLE*" Then
        sDSN = UCase(sUser)
    ElseIf sDriver Like "*SQL SERVER*" Then
        sDSN = "dbo"
    ElseIf sDriver Like "*DB2*" Then
        sDSN = UCase(Import_Form.tbDatabase.Text)
    End If
   
    'Initialise sheet
    Call Init_Sheet
    bWholeDB = False
   
    'Bring up the entire schema if no Table Name was specified or it contains wildcard characters
    If sTableName = "" Or InStr(sTableName, "*") > 0 Then
        Set oRecTables = oSourceDB.OpenSchema(adSchemaTables, Array(Empty, sDSN, Empty, "TABLE"))       ' Retrieve tables in DB
        If sTableName = "" Then
            bWholeDB = True
            sTablePattern = "*"
        End If
    Else
        Set oRecTables = oSourceDB.OpenSchema(adSchemaTables, Array(Empty, sDSN, sTableName, "TABLE"))  ' Retrieve the specific table requested
    End If
   
    Do While Not oRecTables.EOF
        sTableName = UCase(oRecTables.Fields("TABLE_NAME").Value)
        bSkipIt = False
        If bWholeDB Then
            'The tables listed below are unsupported when dealing with a whole database because they're platform-specific
            If sTableName Like "*_ARC" Or sTableName = "BGDEBTP" Or sTableName = "BGDEBTP_DROP_V600" Or sTableName = "BLDEBTP" Or sTableName = "DSN_STATEMNT_TABLE" Or sTableName Like "*_EXP" Or sTableName Like "*_IMP" Or sTableName = "KBSVX01" Or sTableName = "NPTEST" Or sTableName = "O3SVX01" Or sTableName = "PLAN_TABLE" Or sTableName Like "*Q?" Or sTableName Like "*V?" Or sTableName = "T1DEBTQE" Or sTableName Like "Y2*" Or sTableName = "YMBRLST" Or sTableName = "YWDWSRC" Then
                bSkipIt = True
            End If
        End If
        If sTableName Like sTablePattern And Not (sTableName Like sTableExcludePattern) And Not bSkipIt Then
            Set oRecColumns = oSourceDB.OpenSchema(adSchemaColumns, Array(Empty, sDSN, sTableName, Empty))   ' Retrieve columns in table
            'Arrays to hold the column names and types
            ReDim saColNames(MAX_COLUMNS)
            ReDim naDataTypes(MAX_COLUMNS)
            nColumn = 0
            Do While Not oRecColumns.EOF
                saColNames(nColumn) = oRecColumns.Fields("COLUMN_NAME").Value
                naDataTypes(nColumn) = Format(oRecColumns.Fields("DATA_TYPE").Value)
               
                nColumn = nColumn + 1
                oRecColumns.MoveNext
            Loop
            nColumn = nColumn - 1
            sColNames = ""
            For nCol = 0 To nColumn
                sColNames = sColNames & "," & saColNames(nCol)
            Next nCol
            'Remove leading comma
            sColNames = Mid(sColNames, 2)
           
            'Include a Delete statement at the top
            Cells(nExcelRow, 1).Select              'To provide visual feedback to user
            Cells(nExcelRow, 1).Value = "Delete"
            Cells(nExcelRow, 2).Value = sTableName
            nExcelRow = nExcelRow + 1
           
            'Select the whole table
            sSelect = "SELECT " & sColNames & " FROM " & sDSN & "." & sTableName
            Call ADO_Select(oSourceDB, oRecDB, sSelect)
           
            If Not oRecDB.EOF Then
                vRecord = oRecDB.GetRows        'Get all rows at once
                nRecCount = UBound(vRecord, 2)  'Number of records
            Else
                nRecCount = -1
            End If
           
            For nRecord = 0 To nRecCount
                Cells(nExcelRow, 1).Select              'To provide visual feedback to user
                Cells(nExcelRow, 1).Value = "Insert"
                Cells(nExcelRow, 2).Value = sTableName
                nExcelCol = 3

                For nCol = 0 To nColumn
                    If IsNull(vRecord(nCol, nRecord)) Then   'Replace NULL with blank
                        sValue = "'' '"
                    Else
                        sValue = Trim(vRecord(nCol, nRecord))
                        If sValue = "" Then
                            sValue = "'' '"                         'Replace empty with blank
                        Else
                            sValue = Replace(sValue, "'", "")       'Remove apostrophes
                       
                            If naDataTypes(nCol) = DBTYPE_STR Then  'Enclose strings in quotes
                                sValue = "''" & sValue & "'"
                            End If
                        End If
                    End If
                   
                    Cells(nExcelRow, nExcelCol).Value = saColNames(nCol)
                    nExcelCol = nExcelCol + 1
                    Cells(nExcelRow, nExcelCol).Value = sValue
                    nExcelCol = nExcelCol + 1
                   
                    'If we've reached the last column
                    If nCol <> 0 And (nCol Mod 125) = 0 Then
                        nExcelRow = nExcelRow + 1               'Start a new row
                        Cells(nExcelRow, 1).Value = "Continue"
                        nExcelCol = 3
                    End If
                Next nCol
               
                nExcelRow = nExcelRow + 1
            Next nRecord
            Call ADO_Close(oRecDB)
            Call ADO_Close(oRecColumns)
        End If
        oRecTables.MoveNext
       
    Loop

    MsgBox "Importing completed.", 0, APP_NAME

End Sub