Convert VBA Code To VB 6.0 (Use RecordSet)

[RussFishk]

Hello All, I am new to Visual Basic, but I have prior experience with VBA. To make long story short, I was given a project that requires formatting an extract (from Oracle db) into a word document. Basically what I have done is, wrote an extract and saved it as an Excel Document...I have developed the code behind(VBA - Excel) that would run whenever the Excel document is open and writes formatted data to a word document. What I really want to do is write that same code in VB 6.0, execute my query from the code and instead of generating Excel document (really not needed middle step) just populate a RecordSet and then format records just like I have done in VBA + output to a word doc. My problem is that I'm not sure how it is done. I really have all of the logic that goes through the excel records but don't know how to do the same thing with a record set..Nor do I know how to execute my query from VB code...I would appreciate any help!

Below is the VBA code that formats the excel data and writes to a Word doc.

Option Explicit
Public Sub AutoOpen()

Dim LType_State_Number_Desc_ExpDate() As String
Dim State() As String
Dim Number() As String
Dim Descr() As String
Dim ExpDate() As String

Dim numOfRecs As Long
Dim i As Long
Dim dots As String
Dim dotState As String
Dim dotDate As String
Dim dotDesc As String
Dim j As Integer
Dim k As Integer

numOfRecs = FindLastRow

ReDim LType_State_Number_Desc_ExpDate(numOfRecs)

'ReDim BrchState(numOfRecs)
'Dim recordHeader As String
'Dim hdrUnderline As String
'Dim emptyString As String

'recordHeader = "TYPE  ST  NUMBER              DESCRIPTION                                                   EXP DATE"
'hdrUnderline = "----  --  ------              -----------                                                   --------"
'emptyString = "                                                                                                                    "


For i = 0 To numOfRecs - 1
   
    'Debug.Print Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12))))
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 13 Then
        dots = "....."
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 12 Then
        dots = "......"
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 11 Then
        dots = "......."
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 10 Then
        dots = "........"
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 9 Then
        dots = "........."
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 8 Then
        dots = ".........."
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 7 Then
        dots = "..........."
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 6 Then
        dots = "............"
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 5 Then
        dots = "............."
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 4 Then
        dots = ".............."
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 3 Then
        dots = "..............."
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 2 Then
        dots = "................"
    End If
   
    If Len(CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12)))) = 1 Then
        dots = "................."
    End If
   
   
   
    If Len(CStr(Range(Cells(i + 2, 11), Cells(i + 2, 11)))) = 0 Then
   
        dotState = ".."
    Else
        dotState = ""
   
    End If
   
   
    If Len(CStr(Range(Cells(i + 2, 15), Cells(i + 2, 15)))) = 0 Then
        dotDate = ".........."
    Else
        dotDate = ""
    End If
   
   
    j = 40      'may want to determine this programmatically
       
                dotDesc = ""
               
                If j - Len(CStr(Range(Cells(i + 2, 13), Cells(i + 2, 13)))) = 0 Then
                       
                        dotDesc = "..."    '3 chars long
                End If
                   
                If j - Len(CStr(Range(Cells(i + 2, 13), Cells(i + 2, 13)))) > 0 Then
           
                       
                        For k = 1 To j - Len(CStr(Range(Cells(i + 2, 13), Cells(i + 2, 13))))
                           
                            dotDesc = dotDesc + "."
                        Next k
                End If
   
    If Len(CStr(Range(Cells(i + 2, 13), Cells(i + 2, 13)))) > 40 Then
       
       LType_State_Number_Desc_ExpDate(i) = CStr(Range(Cells(i + 2, 10), Cells(i + 2, 10))) + ". " + dotState + CStr(Range(Cells(i + 2, 11), Cells(i + 2, 11))) + " " + CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12))) + dots + " " + Left(CStr(Range(Cells(i + 2, 13), Cells(i + 2, 13))), 40) + dotDesc + " " + CStr(Format(Range(Cells(i + 2, 15), Cells(i + 2, 15)), "mm/dd/yyyy")) + dotDate

    Else
       LType_State_Number_Desc_ExpDate(i) = CStr(Range(Cells(i + 2, 10), Cells(i + 2, 10))) + ". " + dotState + CStr(Range(Cells(i + 2, 11), Cells(i + 2, 11))) + " " + CStr(Range(Cells(i + 2, 12), Cells(i + 2, 12))) + dots + " " + CStr(Range(Cells(i + 2, 13), Cells(i + 2, 13))) + dotDesc + " " + CStr(Format(Range(Cells(i + 2, 15), Cells(i + 2, 15)), "mm/dd/yyyy")) + dotDate

    End If
       
   
        
                                'Debug.Print LType_State_Number_Desc_ExpDate(i)
Next i
   
   
   PrintFormatedRecords LType_State_Number_Desc_ExpDate
  
  
  
End Sub
Public Function FindLastRow()
   
    Dim lastRow As Long
    FindLastRow = Cells(Rows.Count, "A").End(xlUp).Row
    'Debug.Print FindLastRow

End Function
Public Sub PrintFormatedRecords(formatted_recs() As String)

Dim j As Long

Dim recordHeader As String
Dim hdrUnderline As String
Dim emptyString As String
Dim lastRow As Long
Dim costCr As String
Dim tax_id As String
Dim ccAddrss As String
Dim ccCity_state_zip As String
Dim ccPhone As String

lastRow = FindLastRow

recordHeader = "TYPE ST NUMBER             DESCRIPTION                              EXP DATE"
hdrUnderline = "---- -- ------             -----------                              --------"
emptyString = "                                                                            "

j = 2
              
       
       
     '************************ test **********************************
       
        Dim wrdApp As Word.Application
        'Dim wrdDoc As Word.Document
      
       
        'Start a new document in Word
        Set wrdApp = CreateObject("Word.Application")
        wrdApp.Visible = True
               
       
       
        If Dir("C:\Documents and Settings\rfishkin\Desktop\Source_p.doc") <> "" Then
            Kill "C:\Documents and Settings\rfishkin\Desktop\Source_p.doc"
        End If
       
        Open "C:\Documents and Settings\rfishkin\Desktop\Source_p.doc" For Append As #1
       
       
       
   
      '***************************************************************
       
      
  
       
       
       
        Do While Range(Cells(j, 2), Cells(j, 2)) = Range(Cells(j + 1, 2), Cells(j + 1, 2)) And j <= lastRow   'Cost Center

                   
                    costCr = CStr(Range(Cells(j, 2), Cells(j, 2))) + "  " + CStr(Range(Cells(j, 3), Cells(j, 3)))      'For now this line is just a test

                    tax_id = "    Tax ID:  " + CStr(Range(Cells(j, 4), Cells(j, 4)))
                    ccAddrss = CStr(Range(Cells(j, 5), Cells(j, 5)))
                    ccCity_state_zip = CStr(Range(Cells(j, 6), Cells(j, 6)))
                    ccPhone = CStr(Range(Cells(j, 7), Cells(j, 7)))
                   
                   
                    'wrdApp.ActiveDocument.Paragraphs.PageBreakBefore
                   
                    'wrdApp.Selection.InsertBreak  Type:=wdPageBreak
                   
                   
                    Debug.Print emptyString
                     Print #1, emptyString
                    Debug.Print emptyString
                     Print #1, emptyString
                    Debug.Print emptyString
                     Print #1, emptyString
                   
                    Debug.Print costCr
                    Print #1, costCr
                   
                   
                   
                    Debug.Print tax_id
                     Print #1, tax_id
                   
                    Debug.Print ccAddrss
                     Print #1, ccAddrss
                   
                    Debug.Print ccCity_state_zip
                      Print #1, ccCity_state_zip
                   
                    Debug.Print ccPhone
                       Print #1, ccPhone
                   
                    Debug.Print emptyString
                         Print #1, emptyString
                   
                    Debug.Print emptyString
                        Print #1, emptyString
                   
                    Debug.Print emptyString
                        Print #1, emptyString
                   
                    Debug.Print "LICENSES"
                        Print #1, "LICENSES"
                   
                    Debug.Print emptyString
                        Print #1, emptyString
                   
                    Debug.Print emptyString
                        Print #1, emptyString
                   
                    Debug.Print recordHeader
                        Print #1, recordHeader
                   
                    Debug.Print hdrUnderline
                         Print #1, hdrUnderline
                   
                    Do While Range(Cells(j, 9), Cells(j, 9)).Value = "LICENSE"               'all License Records
                   
                        Debug.Print formatted_recs(j - 2)
                            Print #1, formatted_recs(j - 2)
                       
                        'txtfile.WriteLine (formatted_recs(j - 2))
                       
                             
                      
                       
                      
                        j = j + 1
                    Loop
                   
                        Debug.Print emptyString
                            Print #1, emptyString
                       
                        Debug.Print emptyString
                             Print #1, emptyString
                       
                        Debug.Print "BILLING"
                             Print #1, "BILLING"
                       
                        Debug.Print emptyString
                            Print #1, emptyString
                       
                        Debug.Print emptyString
                            Print #1, emptyString
                       
                        Debug.Print recordHeader
                            Print #1, recordHeader
                       
                        Debug.Print hdrUnderline
                             Print #1, hdrUnderline
                       
                    Do While Range(Cells(j, 9), Cells(j, 9)).Value = "BILLING"

                        Debug.Print formatted_recs(j - 2)
                            Print #1, formatted_recs(j - 2)
                        j = j + 1
                    Loop

        Loop
       
   
       
        Close #1
       
        wrdApp.Quit
       
        Set wrdApp = Nothing
   
End Sub

 

[genomon]

For some reason, your post is too wide to display on the page.

10 is company, 11 is a crowd

 

[SkipVought]

Hi,

What you need is to query your Oracle db via ADODB objects.

1. Set a reference to the Microsoft ActiveX Data Objects

2. Use my UDF code as an example of querying.

3. Check out the Recordset Object in Help. You'll need to recordset.movenext to loop thru that object.

Function GetInvData(sPn As String) As Variant
'Skip Metzger/2005 Aug 29/817-280-5438
'--------------------------------------------------
' Access: DWPROD.FRH_MRP.READ
'--------------------------------------------------
'this function returns the sum of On Hand, On Dock & In Transit for a given part number
' where the store type is not 'W'
'--------------------------------------------------
    Dim sConn As String, sSQL As String, sServer As String
    Dim rst As ADODB.Recordset, cnn As ADODB.Connection
    
    Set cnn = New ADODB.Connection
    
    sServer = "DWPROD"
    cnn.Open "Driver={Microsoft ODBC for Oracle};" & _
               "Server=" & sServer & ";" & _
               "Uid=;" & _
               "Pwd="
    
    Set rst = New ADODB.Recordset
    
    sSQL = "SELECT Sum(STKITQTY_233+STKOHQTY_233+QTYONDOK_233) AS Inv_Qty "
    sSQL = sSQL & "FROM FRH_MRP.PSK02233 A "
    sSQL = sSQL & "Where PARTNO_201='" & Trim(sPn) & "' "
    sSQL = sSQL & "  And STORETYP_233<>'W' "
    
    rst.Open sSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText
                          
    rst.MoveFirst
    If IsNull(rst(0)) Then
        GetInvData = 0
    Else
        GetInvData = rst(0)
    End If

    rst.Close
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
End Function

Skip,

_{To be safe on the [red]FOURTH[/red],
Don't take a [red]FIFTH[/red] on the [red]THIRD[/red]
Or you might not come [red]FORTH[/red] on the [red]FIFTH[/red]
[red][highlight blue]FORTH[/highlight][/red][white][highlight red]WITH[/highlight][/white]}

 

[RussFishk]

Thank you Skip! I will try that.