TPE

Tavvafi@gmail.com

≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡

Private wb As Excel.Workbook
Private wkCurrentSht As Excel.Worksheet
Private ExcelApp As Excel.Application
Private ExcelOpened As Boolean
' string arrays
Private arrCols() As String
Dim arrData() As String

Private Sub CreateArrayFromExcel()
' Populates array arrData from selected Excel data
' Called by cmdFinish_Click() (click event handler for Finish button on form)

    Dim strField                As String
    Dim x                       As Long
    Dim y                       As Long
    Dim Num                     As Long
    Dim NumofColumn             As Long
    Dim NumRows                 As Long
    Dim rng                     As Range

    On Error GoTo err_handler

    ExcelApp.DisplayAlerts = False
    ExcelApp.ScreenUpdating = False

    NumofColumn = 0
    ReDim arrCols(0)    ' initialize array to hold column names

    ' When user chose the XLS file and worksheet to use, we
    ' filled the listbox lstFields with the names of the columns (ie, fields)
    ' on the worksheet
    ' Add each selected column name as a new element in the arrray arrCols
    For x = 0 To lstFields.ListCount - 1
        ' is the field selected in lstFields?
        If lstFields.Selected(x) Then
            ' get its name
            strField = Me.lstFields.Column(0, x)
            ' update our counter
            NumofColumn = NumofColumn + 1
            ' add a new element to the array
            ReDim Preserve arrCols(UBound(arrCols) + 1)
            ' and store the column name in the array
            arrCols(UBound(arrCols)) = strField
        End If
    Next

    If NumofColumn > 25 Then
        MsgBox "Please select 25 columns or less", vbInformation
        Exit Sub
    End If

    ' get the requested number of rows of data (ie, records)
    ' and store it in the array arrData

    ' first, how many rows of data must we process?
    ' every row in the worksheet?
    If optAll.Value Then
        Set rng = wkCurrentSht.Range(txtRange.Text)
        NumRows = rng.Rows.Count
        Num = NumRows
    Else    ' a specifc number of rows
        ' make sure that there really are that many rows
        ' if not, use what rows there are
        Set rng = wkCurrentSht.Range(txtRange.Text)
       NumRows = IIf(rng.Rows.Count > VBA.Val(txtNoofRows.Text), VBA.Val(txtNoofRows.Text), rng.Rows.Count)
       Num = NumRows
    End If

    ' NumRows now contains the number of rows to process

    ' dimension the array arrData to the needed number of rows and columns
    ReDim arrData(1 To NumRows, 1 To UBound(arrCols)) As String

    ' fill the data array with data from the worksheet
    For x = 1 To NumRows
        For y = 1 To UBound(arrCols)
            ' assumes data starts in second row after headers in first row
            ' so we offset by one
            arrData(x, y) = wkCurrentSht.Cells(x + 1, y).Value
        Next
    Next

    ' close the XLS workbook, don't save any changes
    wb.Close SaveChanges:=False
    ' release memory used by the workbook
    Set wb = Nothing

    ExcelApp.ScreenUpdating = True

    ' If we originally started Excel to do our bidding, close it
    ' If it was already open, leave it open
    If ExcelOpened Then
        If Not ExcelApp Is Nothing Then
            ExcelApp.Quit
            Set ExcelApp = Nothing
        End If
    End If

    ' Display the data we've pulled from Excel into the arry arrData
    ' You could do the same kind of thing with arrCols to display the field names
    For x = 1 To UBound(arrData, 1)
        For y = 1 To UBound(arrData, 2)
            Debug.Print arrData(x, y)
        Next
    Next


    Exit Sub
err_handler:
    ExcelApp.ScreenUpdating = True
    MsgBox ("Error in CreateArrayFromExcel :" & Err.Description), vbInformation

End Sub