dcsimg
Results 1 to 9 of 9

Thread: [RESOLVED] Create array from tables in different MS Access databases

  1. #1

    Thread Starter
    New Member
    Join Date
    Apr 2018
    Posts
    6

    Resolved [RESOLVED] Create array from tables in different MS Access databases

    Hi Everyone!

    This is my first post in a long time, although this is my go-to source for finding great information--you all are the best!! I am currently in the process of migrating (technically re-writing) an old VB 6 program in VB.NET (2017).

    The app is a customized software that processes data supplied as MS Access tables, then sends it to PowerPoint, Word, and/or Excel to create reports/tables/charts/slides. I am delving into the world of ADO.NET and am struggling translating my old ADO (and limited DAO).

    I have figured out successfully how to create data readers, data tables, data sets, and data relationships. I was able to successfully create data readers and tables, fill an array, and send this data to Excel. What I can't figure out, is how to do this when the data is in two separate Access databases. Below is the code I currently have.

    There is a dataset that includes the data I need from both databases, I'm struggling with how to join those two tables then fill an array with the result of the join.

    I did try a LINQ query but couldn't figure out how to get an array from that result. There are 23 columns of data I need. The column order is not left-right (as in table 1 is on the left then table 2 is on the right)... I have data analysts that use the resulting report in other processes they do so the order matters to them.I have comments in the code where I'm stumped... this is my latest version where I was attempting the use of a data relationship. Is this the right way to go, or LINQ? I really appreciate anyone that has some time to give me some advice!!

    Thanks in advance!!!
    Mary

    Code:
        Private Sub CreateDataQCFile()        'Ensure survey id and shell table are assigned        If (GlobalVar.SurveyID = "") Then            SrtMessage.ShowOKOnly("Survey ID and Shell Table must be assigned to create this report", "Error Creating Briefing Data QC File")            Exit Sub        End If        On Error GoTo EH_CreateDataQCFile_1        '------------------------------------        ' Open/update frmWait        '------------------------------------        FrmWait.Show()        FrmWait.LblWait.Text = "Retrieving Report and Template Information"        FrmWait.PbarWait.Value = 0        FrmWait.LblProgressValue.Visible = False        '-------------------------------------------------------------------        '-------------------------------------------------------------------        ' Fill dataset:  briefing plan, item list, shell table, data table        '-------------------------------------------------------------------        '-------------------------------------------------------------------        ' Briefing Plan table -- all        Dim strSQL As String        OpenSRTDB()        'Briefing Plan        Dim sqlGetData = "SELECT * FROM " & GlobalVar.PlanTable & " ORDER BY Qst_Number, FORMAT(Qst_Subitem, '@@@')"        Using daPlan As New OleDbDataAdapter(sqlGetData, SRTDBcon)            daPlan.Fill(dsDataSet, "dstPlan")        End Using        'Item List -- part of briefing plan        sqlGetData = "SELECT Qst_Number, Qst_Subitem, GroupID, BV_VARNAME, SlideTitle_1, SlideTitle_2, SlideTitle_3, ChartItemText" _                        & " FROM " & GlobalVar.PlanTable & " ORDER BY Qst_Number, FORMAT(Qst_Subitem, '@@@')"        Using daPlan As New OleDbDataAdapter(sqlGetData, SRTDBcon)            daPlan.Fill(dsDataSet, "dstItemList")        End Using        ' Shell Table        sqlGetData = "SELECT B_Order, PopulationSubset, SASValueLabel, CrossVar, CrossVarValue " _                    & "FROM " & GlobalVar.ShellTable & " ORDER BY B_Order"        Using daPlan As New OleDbDataAdapter(sqlGetData, SRTDBcon)            daPlan.Fill(dsDataSet, "dstShell")        End Using        CloseSRTDB()        'Data table        OpenDataDB()        sqlGetData = "SELECT GroupID, CURRENTVAR, VARIABLE, DEPVARLEV, B_Order, CROSSVAR2, CRSSVARVAL, NSUM, P_RESP, SUPP, POINTEST, " _                    & "MARG_ERR, ME0, ME1, AOPOINTEST, P_VALUE, SignificanceValue, SignificanceFormula, SignificanceColor " _                    & "FROM " & GlobalVar.DataTable        Using daPlan As New OleDbDataAdapter(sqlGetData, DataDBcon)            daPlan.Fill(dsDataSet, "dstData")        End Using        CloseDataDB()        'Check to ensure there is at least one record in each table or do not continue        Dim iCheck As Integer        iCheck = dsDataSet.Tables("dstPlan").Rows.Count 'Ensure there is data in the Plan table        If iCheck < 1 Then            SrtMessage.ShowOKOnly("Error retrieving Briefing Plan information, please try again, or contact the SRT Team for assistance", "DS Error: Briefing Plan")            FrmWait.Close()            Exit Sub        End If        iCheck = dsDataSet.Tables("dstItemList").Rows.Count 'Ensure there is data in the ItemList table        If iCheck < 1 Then            SrtMessage.ShowOKOnly("Error retrieving Briefing Plan information, please try again, or contact the SRT Team for assistance", "DS Error: Item List")            FrmWait.Close()            Exit Sub        End If        iCheck = dsDataSet.Tables("dstShell").Rows.Count 'Ensure there is data in the Shell table        If iCheck < 1 Then            SrtMessage.ShowOKOnly("Error retrieving shell information, please try again, or contact the SRT Team for assistance", "DS Error: Shell Table")            FrmWait.Close()            Exit Sub        End If        iCheck = dsDataSet.Tables("dstData").Rows.Count ' Ensure there is data in the data table        If iCheck < 1 Then            SrtMessage.ShowOKOnly("Error retrieving processed data, please try again, or contact the SRT Team for assistance", "DS Error: Data Table")            FrmWait.Close()            Exit Sub        End If        '------------------------------------        ' Get report info from srtReports        '------------------------------------        If SRTFiles.GetReportInfo("Briefing Data QC") = False Then            FrmWait.Close()            SrtMessage.ShowOKOnly("Missing report information, please contact the SRT Programming Team for assistance", "Missing srtReports Table")            Exit Sub        End If        '------------------------------------        'Set report path        '------------------------------------        GlobalVar.RptPath = Application.StartupPath & "" & GlobalVar.SurveyID & "\BriefingDataQC"        '------------------------------------        ' Set full report name        '------------------------------------        If strProductionType = "Briefing" Then            GlobalVar.RptName = Replace(GlobalVar.DataTable, "_BData", "") & GlobalVar.RptName        ElseIf strProductionType = "Trend" Then            GlobalVar.RptName = Replace(GlobalVar.DataTable, "_TCData", "") & GlobalVar.RptName        Else            GlobalVar.RptName = Replace(GlobalVar.DataTable, "_PData", "") & GlobalVar.RptName        End If        SRTFiles.CreateDirectory(GlobalVar.RptPath)  'Create report path if not found        SRTFiles.ArchiveFile(GlobalVar.RptName, GlobalVar.RptPath, GlobalVar.RptExt)  'Archive previous version        '-----------------------------------------        ' Shell Table information        '-----------------------------------------        Dim iSplitAt As Integer = SrtFunctions.WhereInString(GlobalVar.DataTable, "_", 3)        Dim strReportShellTable As String        If iSplitAt > 0 Then            strReportShellTable = SrtFunctions.LeftString(GlobalVar.DataTable, iSplitAt - 1)        Else            SrtMessage.ShowOKOnly("Cannot determine shell table", "Unknown Shell Table")            Exit Sub        End If        '---------------------------------        ' Create Excel File        '---------------------------------        Open_Excel()        On Error GoTo EH_CreateDataQCFile_2        Dim xlBook As Excel.Workbook = Nothing        Dim xlSheet As Excel.Worksheet = Nothing        Dim xlRange As Excel.Range = Nothing        Dim strRptShell As String  'Could be different than assigned/not assigned shell table. Will be based on data selected        xlBook = appExcel.Workbooks.Open(GlobalVar.TemplatePath & GlobalVar.TemplateName & GlobalVar.TemplateExt)        xlBook.SaveAs(GlobalVar.RptPath & GlobalVar.RptName & GlobalVar.RptExt)        'appExcel.ScreenUpdating = False        appExcel.Calculation = Excel.XlCalculation.xlCalculationManual        appExcel.DisplayAlerts = False        '---------------------------------        'Retrieve and insert data        '---------------------------------        FrmWait.LblWait.Text = "Retrieving data and creating report"        xlSheet = xlBook.Worksheets("ItemList")        xlSheet.Activate()        Dim dbTable As New DataTable        Dim iRowCount As Integer = dsDataSet.Tables("dstItemList").Rows.Count        Dim iColumnCount As Single = dsDataSet.Tables("dstItemList").Columns.Count        Dim iColumn As Integer = 0        Dim iRow As Integer = 0        Dim arrData(iRowCount - 1, iColumnCount - 1)        For iRow = 0 To iRowCount - 1            For iColumn = 0 To iColumnCount - 1                If IsDBNull(dsDataSet.Tables("dstItemList").Rows(iRow).Item(iColumn)) Then                    arrData(iRow, iColumn) = ""                Else                    arrData(iRow, iColumn) = CStr(dsDataSet.Tables("dstItemList").Rows(iRow).Item(iColumn))                End If            Next        Next        xlRange = xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(iRowCount + 1, iColumnCount))        xlRange.Select()        xlRange.Value2 = arrData        xlRange = xlSheet.Cells(2, 1)        xlRange.Select()        dsDataSet.Tables.Remove("dstItemList")        iRowCount = 0        iColumnCount = 0        iColumn = 0        iRow = 0        '---------------------------------        'Data worksheet        '---------------------------------        xlSheet = xlBook.Worksheets("BriefingData")        xlSheet.Activate()        '-------------------------------------------------------------------        ' Set data relation: shell table to data table on B_Order        ''-------------------------------------------------------------------        Dim relData As DataRelation        relData = New DataRelation("ReportData", dsDataSet.Tables("dstShell").Columns("B_Order"), dsDataSet.Tables("dstData").Columns("B_Order"), False)        dsDataSet.Relations.Add(relData)        'Can I use this data relation to fill an array, if so how?        'Following is the query of fields that I need in order.  dstShell is table 1, needs to be         'left joined (one to many) with dstData        'Then this needs to go in an array to insert into my existing Excel report        'Dim query = "SELECT dstData.[GroupID], dstData.[CURRENTVAR], dstData.[VARIABLE], dstData.[DEPVARLEV], dstData.[B_Order], dstData.[CROSSVAR2], " _        '& "dstData.[CRSSVARVAL], dstShell.[PopulationSubset], dstShell.[SASValueLabel], dstShell.[CrossVar], dstShell.[CrossVarValue], " _        '& "dstData.[NSUM], dstData.[P_RESP], dstData.[SUPP], dstData.[POINTEST], dstData.[MARG_ERR], dstData.[ME0], dstData.[ME1], " _        '& "dstData.[AOPOINTEST], dstData.[P_VALUE], dstData.[SignificanceValue], dstData.[SignificanceFormula], dstData.[SignificanceColor] " _        '& "FROM (dstData LEFT JOIN dstShell ON (dstData.[B_Order] = dstShell.[B_Order]))" _        '& "ORDER BY dstData.[CURRENTVAR], dstData.[VARIABLE], dstData.[B_Order]"        iColumnCount = 23        iRow = 0        iColumn = 0        'ReDim arrData(?,?)        xlRange = xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(iRowCount + 1, iColumnCount))        xlRange.Select()        xlRange.Value2 = arrData        xlRange = xlSheet.Cells(2, 1)        xlRange.Select()        '-----------------------------------------        'Insert rounded point estimate columns        '-----------------------------------------        For iColumn = 1 To 50            If xlSheet.Cells(1, iColumn).Value = "PointEst" Then                Exit For            End If        Next        Dim strColumnLetter As String = Replace(xlSheet.Cells(1, iColumn).Address, "1", "")        strColumnLetter = Replace(strColumnLetter, "$", "")        iColumn = iColumn + 1        'Insert two columns        xlSheet.Columns(iColumn).EntireColumn.Insert        xlSheet.Columns(iColumn).EntireColumn.Insert        'Insert headings        xlSheet.Cells(1, iColumn).Value = "PointEst Rounded"        xlSheet.Cells(1, iColumn).Interior.ColorIndex = 41        xlSheet.Columns(iColumn).ColumnWidth = 12        xlSheet.Cells(1, iColumn + 1).Value = "PointEst Decimal"        xlSheet.Cells(1, iColumn + 1).Interior.ColorIndex = 41        xlSheet.Columns(iColumn + 1).ColumnWidth = 12        'Remove extra rows        If iRowCount + 1 < 420000 Then            xlSheet.Activate()            xlSheet.Rows(iRowCount + 2 & ":420000").Select            xlSheet.Rows(iRowCount + 2 & ":420000").Delete(Excel.XlDeleteShiftDirection.xlShiftUp)        End If        xlBook.Save()        'Insert rounding formula and fill down column        iRow = 2        Dim xlRangeSource As Excel.Range = xlSheet.Cells(iRow, iColumn)        xlRangeSource.Formula = "=ROUND(" & strColumnLetter & iRow & ",0)"        xlRangeSource.NumberFormat = "0"        xlRangeSource.HorizontalAlignment = Excel.XlHAlign.xlHAlignLeft        Dim xlFillRange As Excel.Range = xlSheet.Range(xlSheet.Cells(iRow, iColumn), xlSheet.Cells(iRowCount + 2, iColumn))        xlRangeSource.AutoFill(Destination:=xlFillRange)        'Insert rounding formula and fill down decimal column        iColumn = iColumn + 1        xlRangeSource = xlSheet.Cells(iRow, iColumn)        xlRangeSource.Formula = "=ROUND(" & strColumnLetter & iRow & ",1)"        xlRangeSource.NumberFormat = "0.0"        xlRangeSource.HorizontalAlignment = Excel.XlHAlign.xlHAlignLeft        xlFillRange = xlSheet.Range(xlSheet.Cells(iRow, iColumn), xlSheet.Cells(iRowCount + 2, iColumn))        xlRangeSource.AutoFill(Destination:=xlFillRange)        '---------------------------------        'Save and Close        '---------------------------------        appExcel.Calculation = Excel.XlCalculation.xlCalculationAutomatic        FrmWait.LblWait.Text = "Saving report"        xlBook.Close(SaveChanges:=True)        Close_Excel()        ReDim arrData(0, 0)        SRTMSO.ReleaseFromMemory(xlBook)        SRTMSO.ReleaseFromMemory(xlSheet)        SRTMSO.ReleaseFromMemory(xlRange)        FrmWait.Close()        Exit Sub 'Exit if no errorEH_CreateDataQCFile_1:        Select Case Err.Number            Case Is = 0, 20  'where no error occurs=0, Resume next error=20                Exit Sub            Case Else                FrmWait.Close()                MsgBox(Err.Number & vbCrLf & Err.Description, vbCritical, "Error while creating Briefing Data QC File")                Exit Sub        End SelectEH_CreateDataQCFile_2:        Select Case Err.Number    'where no error occurs=0, Resume next error=20            Case Is = 0, 20                Exit Sub            Case Else                FrmWait.Close()                MsgBox(Err.Number & vbCrLf & Err.Description, vbCritical, "Error while creating Briefing Data QC File")                Call Close_Excel()                SRTMSO.ReleaseFromMemory(xlBook)                SRTMSO.ReleaseFromMemory(xlSheet)                SRTMSO.ReleaseFromMemory(xlRange)                Exit Sub        End Select    End Sub
    Last edited by mpadilla; Aug 10th, 2018 at 12:31 PM.

  2. #2

    Thread Starter
    New Member
    Join Date
    Apr 2018
    Posts
    6

    Re: Create array from tables in different MS Access databases

    I'm going to try to post the code portion again... I previewed the post before submitting and it looked fine, but I must have done something wrong, all the white space got stripped.

    Code:
        Private Sub CreateDataQCFile()
            'Ensure survey id and shell table are assigned
            If (GlobalVar.SurveyID = "") Then
                SrtMessage.ShowOKOnly("Survey ID and Shell Table must be assigned to create this report", "Error Creating Briefing Data QC File")
                Exit Sub
            End If
            On Error GoTo EH_CreateDataQCFile_1
            '------------------------------------
            ' Open/update frmWait
            '------------------------------------
            FrmWait.Show()
            FrmWait.LblWait.Text = "Retrieving Report and Template Information"
            FrmWait.PbarWait.Value = 0
            FrmWait.LblProgressValue.Visible = False
            '-------------------------------------------------------------------
            '-------------------------------------------------------------------
            ' Fill dataset:  briefing plan, item list, shell table, data table
            '-------------------------------------------------------------------
            '-------------------------------------------------------------------
            ' Briefing Plan table -- all
            Dim strSQL As String
            OpenSRTDB()
            'Briefing Plan
            Dim sqlGetData = "SELECT * FROM " & GlobalVar.PlanTable & " ORDER BY Qst_Number, FORMAT(Qst_Subitem, '@@@')"
            Using daPlan As New OleDbDataAdapter(sqlGetData, SRTDBcon)
                daPlan.Fill(dsDataSet, "dstPlan")
            End Using
            'Item List -- part of briefing plan
            sqlGetData = "SELECT Qst_Number, Qst_Subitem, GroupID, BV_VARNAME, SlideTitle_1, SlideTitle_2, SlideTitle_3, ChartItemText" _
                            & " FROM " & GlobalVar.PlanTable & " ORDER BY Qst_Number, FORMAT(Qst_Subitem, '@@@')"
            Using daPlan As New OleDbDataAdapter(sqlGetData, SRTDBcon)
                daPlan.Fill(dsDataSet, "dstItemList")
            End Using
            ' Shell Table
            sqlGetData = "SELECT B_Order, PopulationSubset, SASValueLabel, CrossVar, CrossVarValue " _
                        & "FROM " & GlobalVar.ShellTable & " ORDER BY B_Order"
            Using daPlan As New OleDbDataAdapter(sqlGetData, SRTDBcon)
                daPlan.Fill(dsDataSet, "dstShell")
            End Using
            CloseSRTDB()
            'Data table
            OpenDataDB()
            sqlGetData = "SELECT GroupID, CURRENTVAR, VARIABLE, DEPVARLEV, B_Order, CROSSVAR2, CRSSVARVAL, NSUM, P_RESP, SUPP, POINTEST, " _
                        & "MARG_ERR, ME0, ME1, AOPOINTEST, P_VALUE, SignificanceValue, SignificanceFormula, SignificanceColor " _
                        & "FROM " & GlobalVar.DataTable
            Using daPlan As New OleDbDataAdapter(sqlGetData, DataDBcon)
                daPlan.Fill(dsDataSet, "dstData")
            End Using
            CloseDataDB()
            'Check to ensure there is at least one record in each table or do not continue
            Dim iCheck As Integer
            iCheck = dsDataSet.Tables("dstPlan").Rows.Count 'Ensure there is data in the Plan table
            If iCheck < 1 Then
                SrtMessage.ShowOKOnly("Error retrieving Briefing Plan information, please try again, or contact the SRT Team for assistance", "DS Error: Briefing Plan")
                FrmWait.Close()
                Exit Sub
            End If
            iCheck = dsDataSet.Tables("dstItemList").Rows.Count 'Ensure there is data in the ItemList table
            If iCheck < 1 Then
                SrtMessage.ShowOKOnly("Error retrieving Briefing Plan information, please try again, or contact the SRT Team for assistance", "DS Error: Item List")
                FrmWait.Close()
                Exit Sub
            End If
            iCheck = dsDataSet.Tables("dstShell").Rows.Count 'Ensure there is data in the Shell table
            If iCheck < 1 Then
                SrtMessage.ShowOKOnly("Error retrieving shell information, please try again, or contact the SRT Team for assistance", "DS Error: Shell Table")
                FrmWait.Close()
                Exit Sub
            End If
            iCheck = dsDataSet.Tables("dstData").Rows.Count ' Ensure there is data in the data table
            If iCheck < 1 Then
                SrtMessage.ShowOKOnly("Error retrieving processed data, please try again, or contact the SRT Team for assistance", "DS Error: Data Table")
                FrmWait.Close()
                Exit Sub
            End If
            '------------------------------------
            ' Get report info from srtReports
            '------------------------------------
            If SRTFiles.GetReportInfo("Briefing Data QC") = False Then
                FrmWait.Close()
                SrtMessage.ShowOKOnly("Missing report information, please contact the SRT Programming Team for assistance", "Missing srtReports Table")
                Exit Sub
            End If
            '------------------------------------
            'Set report path
            '------------------------------------
            GlobalVar.RptPath = Application.StartupPath & "\" & GlobalVar.SurveyID & "\BriefingDataQC\"
            '------------------------------------
            ' Set full report name
            '------------------------------------
            If strProductionType = "Briefing" Then
                GlobalVar.RptName = Replace(GlobalVar.DataTable, "_BData", "") & GlobalVar.RptName
            ElseIf strProductionType = "Trend" Then
                GlobalVar.RptName = Replace(GlobalVar.DataTable, "_TCData", "") & GlobalVar.RptName
            Else
                GlobalVar.RptName = Replace(GlobalVar.DataTable, "_PData", "") & GlobalVar.RptName
            End If
            SRTFiles.CreateDirectory(GlobalVar.RptPath)  'Create report path if not found
            SRTFiles.ArchiveFile(GlobalVar.RptName, GlobalVar.RptPath, GlobalVar.RptExt)  'Archive previous version
            '-----------------------------------------
            ' Shell Table information
            '-----------------------------------------
            Dim iSplitAt As Integer = SrtFunctions.WhereInString(GlobalVar.DataTable, "_", 3)
            Dim strReportShellTable As String
            If iSplitAt > 0 Then
                strReportShellTable = SrtFunctions.LeftString(GlobalVar.DataTable, iSplitAt - 1)
            Else
                SrtMessage.ShowOKOnly("Cannot determine shell table", "Unknown Shell Table")
                Exit Sub
            End If
            '---------------------------------
            ' Create Excel File
            '---------------------------------
            Open_Excel()
            On Error GoTo EH_CreateDataQCFile_2
            Dim xlBook As Excel.Workbook = Nothing
            Dim xlSheet As Excel.Worksheet = Nothing
            Dim xlRange As Excel.Range = Nothing
            Dim strRptShell As String  'Could be different than assigned/not assigned shell table. Will be based on data selected
            xlBook = appExcel.Workbooks.Open(GlobalVar.TemplatePath & GlobalVar.TemplateName & GlobalVar.TemplateExt)
            xlBook.SaveAs(GlobalVar.RptPath & GlobalVar.RptName & GlobalVar.RptExt)
            'appExcel.ScreenUpdating = False
            appExcel.Calculation = Excel.XlCalculation.xlCalculationManual
            appExcel.DisplayAlerts = False
            '---------------------------------
            'Retrieve and insert data
            '---------------------------------
            FrmWait.LblWait.Text = "Retrieving data and creating report"
            xlSheet = xlBook.Worksheets("ItemList")
            xlSheet.Activate()
    
            Dim dbTable As New DataTable
            Dim iRowCount As Integer = dsDataSet.Tables("dstItemList").Rows.Count
            Dim iColumnCount As Single = dsDataSet.Tables("dstItemList").Columns.Count
            Dim iColumn As Integer = 0
            Dim iRow As Integer = 0
            Dim arrData(iRowCount - 1, iColumnCount - 1)
    
            For iRow = 0 To iRowCount - 1
                For iColumn = 0 To iColumnCount - 1
                    If IsDBNull(dsDataSet.Tables("dstItemList").Rows(iRow).Item(iColumn)) Then
                        arrData(iRow, iColumn) = ""
                    Else
                        arrData(iRow, iColumn) = CStr(dsDataSet.Tables("dstItemList").Rows(iRow).Item(iColumn))
                    End If
                Next
            Next
            xlRange = xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(iRowCount + 1, iColumnCount))
            xlRange.Select()
            xlRange.Value2 = arrData
            xlRange = xlSheet.Cells(2, 1)
            xlRange.Select()
            dsDataSet.Tables.Remove("dstItemList")
            iRowCount = 0
            iColumnCount = 0
            iColumn = 0
            iRow = 0
            '---------------------------------
            'Data worksheet
            '---------------------------------
            xlSheet = xlBook.Worksheets("BriefingData")
            xlSheet.Activate()
    
            '-------------------------------------------------------------------
            ' Set data relation: shell table to data table on B_Order
            ''-------------------------------------------------------------------
            Dim relData As DataRelation
            relData = New DataRelation("ReportData", dsDataSet.Tables("dstShell").Columns("B_Order"), dsDataSet.Tables("dstData").Columns("B_Order"), False)
            dsDataSet.Relations.Add(relData)
    
    
            'Can I use this data relation to fill an array, if so how?
            'Following is the query of fields that I need in order.  dstShell is table 1, needs to be 
            'left joined (one to many) with dstData
            'Then this needs to go in an array to insert into my existing Excel report
    
            'Dim query = "SELECT dstData.[GroupID], dstData.[CURRENTVAR], dstData.[VARIABLE], dstData.[DEPVARLEV], dstData.[B_Order], dstData.[CROSSVAR2], " _
            '& "dstData.[CRSSVARVAL], dstShell.[PopulationSubset], dstShell.[SASValueLabel], dstShell.[CrossVar], dstShell.[CrossVarValue], " _
            '& "dstData.[NSUM], dstData.[P_RESP], dstData.[SUPP], dstData.[POINTEST], dstData.[MARG_ERR], dstData.[ME0], dstData.[ME1], " _
            '& "dstData.[AOPOINTEST], dstData.[P_VALUE], dstData.[SignificanceValue], dstData.[SignificanceFormula], dstData.[SignificanceColor] " _
            '& "FROM (dstData LEFT JOIN dstShell ON (dstData.[B_Order] = dstShell.[B_Order]))" _
            '& "ORDER BY dstData.[CURRENTVAR], dstData.[VARIABLE], dstData.[B_Order]"
            iColumnCount = 23
            iRow = 0
            iColumn = 0
    
            'ReDim arrData(?,?)
    
            xlRange = xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(iRowCount + 1, iColumnCount))
            xlRange.Select()
            xlRange.Value2 = arrData
            xlRange = xlSheet.Cells(2, 1)
            xlRange.Select()
            '-----------------------------------------
            'Insert rounded point estimate columns
            '-----------------------------------------
            For iColumn = 1 To 50
                If xlSheet.Cells(1, iColumn).Value = "PointEst" Then
                    Exit For
                End If
            Next
            Dim strColumnLetter As String = Replace(xlSheet.Cells(1, iColumn).Address, "1", "")
            strColumnLetter = Replace(strColumnLetter, "$", "")
            iColumn = iColumn + 1
            'Insert two columns
            xlSheet.Columns(iColumn).EntireColumn.Insert
            xlSheet.Columns(iColumn).EntireColumn.Insert
            'Insert headings
            xlSheet.Cells(1, iColumn).Value = "PointEst Rounded"
            xlSheet.Cells(1, iColumn).Interior.ColorIndex = 41
            xlSheet.Columns(iColumn).ColumnWidth = 12
            xlSheet.Cells(1, iColumn + 1).Value = "PointEst Decimal"
            xlSheet.Cells(1, iColumn + 1).Interior.ColorIndex = 41
            xlSheet.Columns(iColumn + 1).ColumnWidth = 12
            'Remove extra rows
            If iRowCount + 1 < 420000 Then
                xlSheet.Activate()
                xlSheet.Rows(iRowCount + 2 & ":420000").Select
                xlSheet.Rows(iRowCount + 2 & ":420000").Delete(Excel.XlDeleteShiftDirection.xlShiftUp)
            End If
            xlBook.Save()
            'Insert rounding formula and fill down column
            iRow = 2
            Dim xlRangeSource As Excel.Range = xlSheet.Cells(iRow, iColumn)
            xlRangeSource.Formula = "=ROUND(" & strColumnLetter & iRow & ",0)"
            xlRangeSource.NumberFormat = "0"
            xlRangeSource.HorizontalAlignment = Excel.XlHAlign.xlHAlignLeft
            Dim xlFillRange As Excel.Range = xlSheet.Range(xlSheet.Cells(iRow, iColumn), xlSheet.Cells(iRowCount + 2, iColumn))
            xlRangeSource.AutoFill(Destination:=xlFillRange)
            'Insert rounding formula and fill down decimal column
            iColumn = iColumn + 1
            xlRangeSource = xlSheet.Cells(iRow, iColumn)
            xlRangeSource.Formula = "=ROUND(" & strColumnLetter & iRow & ",1)"
            xlRangeSource.NumberFormat = "0.0"
            xlRangeSource.HorizontalAlignment = Excel.XlHAlign.xlHAlignLeft
            xlFillRange = xlSheet.Range(xlSheet.Cells(iRow, iColumn), xlSheet.Cells(iRowCount + 2, iColumn))
            xlRangeSource.AutoFill(Destination:=xlFillRange)
            '---------------------------------
            'Save and Close
            '---------------------------------
            appExcel.Calculation = Excel.XlCalculation.xlCalculationAutomatic
            FrmWait.LblWait.Text = "Saving report"
            xlBook.Close(SaveChanges:=True)
            Close_Excel()
            ReDim arrData(0, 0)
            SRTMSO.ReleaseFromMemory(xlBook)
            SRTMSO.ReleaseFromMemory(xlSheet)
            SRTMSO.ReleaseFromMemory(xlRange)
            FrmWait.Close()
            Exit Sub 'Exit if no error
    EH_CreateDataQCFile_1:
            Select Case Err.Number
                Case Is = 0, 20  'where no error occurs=0, Resume next error=20
                    Exit Sub
                Case Else
                    FrmWait.Close()
                    MsgBox(Err.Number & vbCrLf & Err.Description, vbCritical, "Error while creating Briefing Data QC File")
                    Exit Sub
            End Select
    EH_CreateDataQCFile_2:
            Select Case Err.Number
        'where no error occurs=0, Resume next error=20
                Case Is = 0, 20
                    Exit Sub
                Case Else
                    FrmWait.Close()
                    MsgBox(Err.Number & vbCrLf & Err.Description, vbCritical, "Error while creating Briefing Data QC File")
                    Call Close_Excel()
                    SRTMSO.ReleaseFromMemory(xlBook)
                    SRTMSO.ReleaseFromMemory(xlSheet)
                    SRTMSO.ReleaseFromMemory(xlRange)
                    Exit Sub
            End Select
    
        End Sub

  3. #3
    Frenzied Member
    Join Date
    Jun 2014
    Posts
    1,045

    Re: Create array from tables in different MS Access databases

    i am not sure if this is what you want:
    the getrows method creates a variant array out of a recordset
    the following joins a table in 3 different databases into 1 recordset
    Code:
    SELECT * FROM Tabel1  in 'c:\directory1\db1.mdb'
    UNION ALL SELECT * FROM Tabel1 in 'c:\directory2\db1.mdb'
    UNION ALL SELECT * FROM Tabel1 in 'c:\directory3\db1.mdb';
    do not put off till tomorrow what you can put off forever

  4. #4

    Thread Starter
    New Member
    Join Date
    Apr 2018
    Posts
    6

    Re: Create array from tables in different MS Access databases

    Hi IkkeEnGij,

    Thanks for the reply, I very much appreciate your assistance.

    Pardon my naivety, but that looks like what I used to write in the old ADO, I'm trying to translate it to the new ADO.NET. From what I've found so far, it's pretty easy to pull from one database, but everything I find requires the connection object to the database... how do you create that connection to both without doing them separately into a data set (which is what I'm currently doing)?

    Or am I completely missing what your advice is saying.

    Thanks,
    Mary

  5. #5
    Frenzied Member
    Join Date
    Jun 2014
    Posts
    1,045

    Re: Create array from tables in different MS Access databases

    There is a dataset that includes the data I need from both databases, I'm struggling with how to join those two tables
    ??
    maybe use the merge method of the datatable object ?
    do not put off till tomorrow what you can put off forever

  6. #6

    Thread Starter
    New Member
    Join Date
    Apr 2018
    Posts
    6

    Re: Create array from tables in different MS Access databases

    It doesn't look like merge would be the right approach, the table schemas are not the same (not even remotely).

    I have records in one table that need to be joined with the records in the second table -- Left join, one to many.

  7. #7
    Frenzied Member ChrisE's Avatar
    Join Date
    Jun 2017
    Location
    Frankfurt
    Posts
    1,125

    Re: Create array from tables in different MS Access databases

    Hi,

    I think you should break this up a bit, why not create a New Database an Export the Data you need first

    with SQL you can Create;Alter etc.. Tables.

    here a few samples I Posted a while back to sombody

    Code:
    Imports System.Data.OleDb
    
    Public Class Form1
    
        Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
            CreateTable()
        End Sub
    
        Public Sub CreateTable()
            Dim sSQL As String = Nothing
            Dim con As OleDbConnection = New OleDbConnection("Provider=Microsoft.jet.oledb.4.0;data source=D:\NWIND.mdb")
            'here you create your Table in the Database
            'Cust_ID will be AutoIncrement Field
            sSQL = sSQL & "  Create Table tbl_NewTable"
            sSQL = sSQL & "( [Cust_ID] Integer Identity"
            sSQL = sSQL & ", [CustomerName] varChar(50)"
            sSQL = sSQL & ", [Product] varChar(50)"
            sSQL = sSQL & ")"
            con.Open()
            ExecuteSQL(con, sSQL)
            con.Close()
            con = Nothing
        End Sub
    
        Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
            'Step2 : Insert the DISTINCT CustomerNames
            Dim sSql As String
            Dim con As OleDbConnection = New OleDbConnection("Provider=Microsoft.jet.oledb.4.0;data source=D:\NWind.mdb")
    
            'Import From Excel to the new Table
            sSql = "Insert Into tbl_NewTable Select Distinct CustomerName,Product From [Sheet1$] In 'C:\Customers.xls' 'EXCEL 8.0;' "
    
            ''Export to diffrent MDB
            'sSql = "SELECT * INTO Tabelle1A IN 'c:\test\Chris.mdb' FROM Tabelle1A;"
    
            ''Import from another MDB
            'sSql = "Select * Into Tabelle1C From Tabelle1A In 'c:\test\Chris.mdb'"
    
            con.Open()
            ExecuteSQL(con, sSql)
            con.Close()
            con = Nothing
        End Sub
    
        Public Function ExecuteSQL(ByVal Con As OleDb.OleDbConnection, _
                                       ByVal sSQL As String, _
                                       Optional ByRef ErrMessage As String = Nothing, _
                                       Optional ByVal TransAction As  _
                                       OleDb.OleDbTransaction = Nothing) As Integer
            ErrMessage = Nothing
            Try
                Dim Result As Integer = 0
                Using Cmd As New OleDb.OleDbCommand(sSQL, Con, TransAction)
                    Result = Cmd.ExecuteNonQuery
                End Using
                Return Result
            Catch ex As Exception
                ErrMessage = ex.Message
                Return 0
            End Try
        End Function
    
       
    
        'Step3: create your Index
        Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
            CreateIndex()
        End Sub
    
        Public Sub CreateIndex()
            Dim sSQL As String = Nothing
            Dim con As OleDbConnection = New OleDbConnection("Provider=Microsoft.jet.oledb.4.0;data source=D:\NWIND.mdb")
            sSQL = sSQL & "Alter Table [tbl_NewTable] Add Constraint [PrimaryKey] Primary Key (Cust_ID)"
            con.Open()
            ExecuteSQL(con, sSQL)
            con.Close()
            con = Nothing
        End Sub
    
        Public Sub CreateTableProducts()
            Dim sSQL As String = Nothing
            Dim con As OleDbConnection = New OleDbConnection("Provider=Microsoft.jet.oledb.4.0;data source=D:\NWIND.mdb")
            'here you create your Table in the Database
            'Cust_ID will be AutoIncrement Field
            sSQL = sSQL & "  Create Table tbl_Products"
            sSQL = sSQL & "( [Pro_ID] Integer Identity"
            sSQL = sSQL & ", [ProducName] varChar(50)"
            sSQL = sSQL & ", [Product] varChar(50)"
            sSQL = sSQL & ")"
            con.Open()
            ExecuteSQL(con, sSQL)
            con.Close()
            con = Nothing
        End Sub
    End Class
    try and sort out the Imported Data there

    regards
    Chris
    to hunt a species to extinction is not logical !
    since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.

  8. #8

    Thread Starter
    New Member
    Join Date
    Apr 2018
    Posts
    6

    Re: [RESOLVED] Create array from tables in different MS Access databases

    Thank you so much IkkeEnGij and Chris.

    After reading through your suggestion Chris it dawned on me that I was making this particular problem harder than I needed to and was overthinking it. One of the databases I create in previous parts of the program so I am simply inserting the data into that one for the Join, then delete it when I'm done. I had just started creating that second database before they abruptly took my VB 6 away so I am not used to it as part of the big picture just yet. The other databases I have less control over, and this approach works for when I have to join from three databases, which will come up during the rewrite as well.

    So using my connection objects and .ExecuteNonQuery I will have the tools to cover everything I have to rewrite. This will also allow me to move all my old SQL statements over. Easy-peasy (she says as she slaps her head in the "well duh" moment!!!).

    Later I will learn more about LINQ, but for now will be able to finish my task at hand much faster.

    Thanks all!!

  9. #9

    Thread Starter
    New Member
    Join Date
    Apr 2018
    Posts
    6

    Re: [RESOLVED] Create array from tables in different MS Access databases

    Thank you so much IkkeEnGij and Chris.

    After reading through your suggestion Chris it dawned on me that I was making this particular problem harder than I needed to and was overthinking it. One of the databases I create in previous parts of the program so I am simply inserting the data into that one for the Join, then delete it when I'm done. I had just started creating that second database before they abruptly took my VB 6 away so I am not used to it as part of the big picture just yet. The other databases I have less control over, and this approach works for when I have to join from three databases, which will come up during the rewrite as well.

    So using my connection objects and .ExecuteNonQuery I will have the tools to cover everything I have to rewrite. This will also allow me to move all my old SQL statements over. Easy-peasy (she says as she slaps her head in the "well duh" moment!!!).

    Later I will learn more about LINQ, but for now will be able to finish my task at hand much faster.

    Thanks all!!

Posting Permissions

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



Featured


Click Here to Expand Forum to Full Width