Make My Code Correct...Excel Report

[Jaseem Ahmed]

Option Explicit
Private con As New ADODB.Connection
Public RS As New ADODB.Recordset
Public RS1 As New ADODB.Recordset
Public cmd As String
Dim ExlObj As New Excel.Application
Private Declare Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
'Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Sub MyDatacon()
If con.State = 1 Then con.Close
con.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=ISIS_157;Data Source=JASEEMAHMED"
con.Open
End Sub

Private Sub Command1_Click()
On Error Resume Next
  Dim lc, NxtLine, k
  Call MyDatacon
  Set ExlObj = CreateObject("Excel.application")
  ExlObj.Workbooks.Add
  RS.Open "SELECT CUSTOMERNAME,Shopname,Contactperson, Address,Street,City,Phone,Fax from customer where customercode='" + Trim(List1.Text) + "'", con, adOpenStatic, adLockOptimistic
    If Not RS.EOF Then
    ExlObj.Visible = True
With ExlObj.ActiveSheet
.Cells(1, 3).Value = "Visual Basic Data in Vb"
            .Cells(1, 3).Font.Name = "Verdana"
            .Cells(1, 3).Font.Bold = True:
            .Cells(4, 1).Value = "Customername":    .Cells(4, 2).Value = "city"
            .Cells(4, 3).Value = "Shopname":        .Cells(4, 4).Value = "phone"
            .Cells(4, 5).Value = "Contactperson":    .Cells(4, 6).Value = "fax"
            .Cells(4, 7).Value = "address"
          End With
          End If
For k = 1 To RS.Fields.Count
            ExlObj.ActiveSheet.Cells(4, k).Font.Bold = True
            ExlObj.ActiveSheet.Cells(4, k).Font.Color = vbWhite
Next
        Set k = Nothing
        NxtLine = 5
        
        
        Do Until RS.EOF
        For lc = 0 To RS.Fields.Count - 1
         ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = RS.Fields(lc)
               Next
            RS.MoveNext
            NxtLine = NxtLine + 1
        Loop
          ExlObj.ActiveCell.Worksheet.Cells(NxtLine, lc + 1).AutoFormat xlRangeAutoFormatList2, 0, 3, 1, True, True
               
               
               ExlObj.ActiveCell.Worksheet.Cells(4, 1).Subtotal 4, xlSum, (6), 0, 0, xlSummaryBelow
End Sub

Private Sub Form_Load()
Call MyDatacon
RS.Open "SELECT DISTINCT Customercode from Customer ", con, adOpenStatic, adLockOptimistic
While Not RS.EOF
List1.AddItem RS.Fields(0).Value
RS.MoveNext
Wend
End Sub

customer codes are listed in list box, and when choosing any code and clicking command 1, it exports the sheet, where all the coloum names that i have written above are shown, but no any data is called from database, it it runs an infinite loop on

NxtLine = NxtLine + 1

please i need an argent help.

[BitBlt]

I rebuilt your code line by line from your listing above, and it worked fine.

The only thing I can suggest is to use debug.print, step through execution, trap your generated SQL statment and execute it manually in Management Studio (or Query Analyzer, as the case may be), and check to see that it's actually returning rows. Otherwise I see nothing wrong with your program.

Other than your indentation makes it a little difficult to read. :)

Another thought...you use On Error Resume Next. This means that there could be an error condition in your code that you aren't trapping, and you'd never know it. You might consider using a construct like:

On Error GoTo MyExecution_Err
...
... your code here
...
MyExecution_Resume:

Exit sub

MyExecution_Err:
If con.Errors.Count > 0 Then
    For i = 0 To con.Errors.Count - 1
        myMsg = myMsg & vbCrLf & con.Errors(i).Number & ": " & con.Errors(i).Description
    Next i
    MsgBox "SQL Errors:" & vbCrLf & myMsg, vbOKOnly + vbCritical, "Execute SQL Statement"
Else
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, me.Caption
End If

Resume MyExecution_Resume

end sub

[Jaseem Ahmed]

not working......what is Mymsg??? u used a word here mymsg?? what is that, it is erroring

[Jaseem Ahmed]

not working....same error...
can u please post the above code with my code with setting...i have setted bt still its error is same.

[BitBlt]

Sorry about that...forgot about your Option Explicit at the top. Just put this somewhere in your Command1_Click routine:

dim myMsg as string

It's only used for displaying error messages, not important for your main processing.

[gsatya]

Pls check this line:
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = RS.Fields(lc)
I think it should be
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = RS.Fields(lc).value

[Harshasr8]

As you have given ExlObj.Visible = True in Command1_Click
You should be able to see the excel sheet and all the data being written in to the excel.
Are you able to see any data being written into the excel sheet?
Or does your program just hangs as soon as you click on the button?:-/

[Jaseem Ahmed]

@ GSatya....it is not the problem....i have tried this also but doesnt work that too....

@HarShasr....as i m clicking Command Button, it opens Execl File, and also shows the data which i have manually added in coluoms...but it is not calling any data from database and goes to infinite loop...

Do Until RS.EOF
For lc = 0 To RS.Fields.Count - 1
ExlObj.ActiveSheet.Cells(NxtLine, lc + 1).Value = RS.Fields(lc)
Next   ''''Here it Errors/
RS.MoveNext
NxtLine = NxtLine + 1
Loop

[gsatya]

Hi, I am attaching the project which you did I think there is no problem it worked fine in my system.

Just create a dsn and change the name of the dsn in the code instead of giving entire connection string (I did this for testing purpose not a modification in your code)
the archive also contains the output xls files for your ready reference check it is working fine.

WBR
G. Satya