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"
End Sub

Private Sub Command1_Click()
On Error Resume Next
  Dim lc, NxtLine, k
  Call MyDatacon
  Set ExlObj = CreateObject("Excel.application")
  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
        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)
            NxtLine = NxtLine + 1
          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
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.

5 Years
Discussion Span
Last Post by gsatya

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

Exit sub

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"
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, me.Caption
End If

Resume MyExecution_Resume

end sub

Edited by BitBlt: Added error trapping routine


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


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.


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.

Edited by BitBlt: n/a


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


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?:-/

Edited by Harshasr8: n/a


@ 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/
NxtLine = NxtLine + 1

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.

G. Satya

This topic has been dead for over six months. Start a new discussion instead.
Have something to contribute to this discussion? Please be thoughtful, detailed and courteous, and be sure to adhere to our posting rules.