Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all articles
Browse latest Browse all 1532

VB Export Project

$
0
0
Hi

I have a code below to export data from sql server db "Hpacc4" to Excel. my code just error at: rsHPData.MoveFirst, with error "Either BOF or EOF is True, or the current record has been deleted"

Please help

Code:


Private Sub btnRecon_Click() 'Export to Excel Button
 
  Dim tsql As String
 Dim oExcel As Object
 Dim oWB As Object
 Dim oWS As Object
 
  ' // ----------------------------------- //
  ' // Set up a connection to the DataBase //
  ' // ----------------------------------- //

  Set cnHPtest = New ADODB.Connection
  Set rsHPData = New ADODB.Recordset

  With cnHPtest
    .Provider = strDBProv
    .ConnectionString = strDBString
    .CommandTimeout = 1000
    .Open
  End With
 
 Screen.MousePointer = vbHourglass
    Dim x As Integer, numRecs As Integer

    Set oExcel = CreateObject("Excel.Application")
    Set oWB = oExcel.Workbooks.Add
    Set oWS = oWB.Worksheets("Sheet1")

        With rsHPData
            .CursorLocation = adUseClient
            .LockType = adLockReadOnly
            .Open "Select RunMonth, SalaryBill, Rate from Hpacc4 where Scheme = '" & frmLogin.MaskEdBox1.Text & "' AND RunMonth = '" & MaskEdDate.Text & "' AND AccCode = '110'", cnHPtest, adOpenForwardOnly, adLockReadOnly
        End With
       
        If rsHPData.EOF And rsHPData.BOF Then
       
        'Set rs = cmd.Execute()
        numRecs = rsHPData.RecordCount
        rsHPData.MoveFirst
       
        With oWS
          'SET THE TOP ROWS WITH TITLES--Change Font to Bold and Make The Font RED
            .Range("A1:C1").Font.Bold = True 'sets top row (stuff below) in bold print
            .Range("A1:C1").Font.ColorIndex = 3 'change font color to red
              .Cells(1, 1).Value = "STATE NAME"
              .Cells(1, 2).Value = "STATE ABBREVIATION"
              .Cells(1, 3).Value = "DATE ENTERED UNION"
        'Run through the RECORDSET, stating in ROW 2, until end of the RECORDSET
        For x = 2 To numRecs + 1  ' You can do this differently without using numRecs (do while not rs.eof)
              .Cells(x, 1).Value = Trim(rsHPData!RunMonth)  'State is a TEXT Field in my db
              .Cells(x, 2).Value = Trim(rsHPData!SalaryBill)      'St is a TEXT Field in my db
              .Cells(x, 3).Value = Trim(rsHPData!Rate)  'date_orig is a DATE Field in my db
        rsHPData.MoveNext  'Move through the RECORDSET
        Next x
        End With
        End If
        'This for-loop makes the columns just wide enough for the largest 'string' in each column
        For x = 1 To 3 'where 3, in my case is three columns  (State Name, State Abbreviation and Date Entered Union
              oWS.Columns(x).AutoFit
          Next x
        'close down the rs and connection
        rsHPData.Close
        cnHPtest.Close
        oExcel.Visible = True  'so you can see what you did
        'set up the active excel sheet
        Set oWS = oExcel.ActiveSheet
        Set oWB = oExcel.ActiveWorkbook
        oWB.SaveAs FileName:=App.Path + "\testfile.xlsx"  'use whatever name you want here
    Screen.MousePointer = vbDefault
End Sub


Viewing all articles
Browse latest Browse all 1532

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>