Hi All, i generate excel report with 0 error, the issue i have it's just repeat value as shown below for example. please what i'm missing? Thank you for your time spending here.
Code:
[Group Title] [Dealer Name] [Total]
Tele philip 3
basil
brss
Agri David 4
ahm
qwe
Jack
Tele philip 3
basil
brssCode:
On Error GoTo ErrorHandle
Dim dFrom As Date
Dim dTo As Date
Dim cnn As New ADODB.Connection
Dim xlApp As New Excel.Application
Dim xlwk As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
Dim rs1 As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Dim rs3 As ADODB.Recordset
Dim strSQL As String
Dim lngnumCount As Long
Dim lngActive As Long
Dim lngdatCount As Long
Dim intCount As Integer
Dim ctr As Long
Dim ctr1 As Long
Dim vernum As String
'Dim i As Integer
'Dim strSeriesCell As String
strDate = Format(Date, "yyyy/MM/dd")
cnn.ConnectionTimeout = 15
cnn.CommandTimeout = 30
Set cnn = New ADODB.Connection
Constring = "Provider= MSDASQL;" & _
"DRIVER=Sql Server;" & _
"SERVER=BARQCELL-PC;" & _
"DATABASE=DSS;" & _
"UID=sa;" & _
"PWD=666;"
cnn.ConnectionString = Constring
cnn.Open
xlApp.Interactive = True
Set xlwk = xlApp.Workbooks.Open(App.path & "\midAgents.xls")
Set xlSheet = xlwk.Worksheets("Report1")
xlSheet.Select
ctr = 11 ' start data after headings
strSQL = "SELECT DISTINCT Dealer_Name ,Group_Title FROM [DSS].[dbo].[tblCustomer] where Group_Title>'0'"
Set rs1 = New ADODB.Recordset
rs1.Open strSQL, cnn, adOpenStatic, adLockOptimistic
If Not rs1.EOF Then
Do Until rs1.EOF
strSQL = "SELECT Count(*) AS Group_TitleCount FROM tblcustomer WHERE Group_Title = '" & rs1![Group_Title] & "' "
Set rs2 = New ADODB.Recordset
rs2.Open strSQL, cnn, adOpenStatic, adLockOptimistic
lngnumCount = rs2![Group_TitleCount]
rs2.Close
strSQL = "SELECT DISTINCT Dealer_Name From tblCustomer WHERE Group_Title = '" & rs1![Group_Title] & "'"
rs2.Open strSQL, cnn, adOpenStatic, adLockOptimistic
ctr = ctr + 1
xlApp.Range("C" & Trim(Str(ctr))).value = lngnumCount
xlApp.Range("D" & Trim(Str(ctr))).value = rs1![Group_Title]
Do Until rs2.EOF
xlApp.Range("E" & Trim$(Str(ctr))).value = rs2![Dealer_Name]
ctr = ctr + 1
rs2.MoveNext
Loop
rs2.Close
Set rs2 = Nothing
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
xlApp.Visible = True
xlwk.Worksheets("Report1").SaveAs "E:Reports\MainDealer" & vernum & Format(Date, "~dd-MM-yyyy") & ".xls"
Exit Sub
' & Format(Time, "(h-mm-ss)")
Else
MsgBox ".NO Data availible", vbExclamation, "Confirm"
'xlwk.Close
End If
ErrorHandle:
MsgBox err.Description