Can any one please tell me how to i create a blank excel file. I need a
blank file where i can dump the data from the query
strSource = "\\usnymel1fs001\new claims\IDT Carmel\upload\" & "Close And Returns
File" & " " & Format(Date, "MMDDYY") & ".xls"
ORIGINAL CODE
Private Sub QueryProcess()
Dim DBConn
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim rngColumn As Excel.Range
Dim rngCell As Excel.Range
Dim strSource As String
Dim mysheet As String
Dim lngRow As Long
Dim RS
'This is Adaptive Server Enterprise Connection
Set DBConn = CreateObject("ADODB.Connection")
DBConn.Open "ODBC; Driver=Adaptive Server Anywhere 6.0; DSN=Debtmaster; uid=dm;
pwd=,,PeAches..;"
Dim sSQL As String
sSQL = "select clt_ref_no as CFG_ACCOUNT, " & _
"(case " & _
" when r.status_code in ('400','404','407') then 'OVBK' " & _
" when r.status_code in ('210','420','430','470','630') then 'OVUN' " & _
" when r.status_code in ('435') then 'OVRC' " & _
" when r.status_code in ('450') then 'OVDC' " & _
" when r.status_code in ('487') then 'OVFA' " & _
" when r.status_code = '491' then 'OCAC' " & _
" when r.status_code = '510' then 'OSIF' " & _
" when r.status_code='520' then 'OPIF' " & _
" else 'CHECK STATUS' " & _
" END) as REASON, " & _
"(SELECT LONGSTR FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND
LABEL='BANKRUPTCYCHAPTER') AS BANKRUPTCYCHAPTER, " & _
"(SELECT LONGSTR FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND
LABEL='CASENUMBER') AS CASENUM, " & _
"CONVERT(CHAR(10),(SELECT DATE1 FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND
LABEL='FILEDATE'),101) AS BKTFILEDATE, " & _
"CONVERT(CHAR(10),(SELECT DATE1 FROM DBTRUDF U WHERE R.DEBTOR_ID=U.DEBTOR_ID AND
LABEL='DECEASEDDATE'),101) AS DATEOFDEATH, " & _
" STATUS_DESCR AS COMMENTS, " & _
" substring(DEBT_DESCR,(LOCATE(DEBT_DESCR,':',1)+1), 30) AS ORIGINALACCOUNT "
& _
"FROM DEBT_VIEW S JOIN DBTR R ON S.DEBT_ID=R.DEBTOR_ID " & _
"WHERE CLT_ID LIKE 'IDTC%' AND R.STATUS_CODE>='400' AND
R.STATUS_DATE>'2007-02-25' ; "
Set RS = DBConn.Execute(sSQL)
strSource = "\\usnymel1fs001\new claims\IDT Carmel\upload\" & "Close And
Returns File" & " " & Format(Date, "MMDDYY") & ".xls"
Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strSource)
mysheet = xlApp.Worksheets(1).Name
Set xlWS = xlWb.Worksheets(mysheet)
xlWS.Range("A1").Value = "CFG_ACCOUNT"
xlWS.Range("B1").Value = "STATUS"
xlWS.Range("C1").Value = "BKT CAHPTER"
xlWS.Range("D1").Value = "BKT CASE#"
xlWS.Range("E1").Value = "BKT FILE DATE"
xlWS.Range("F1").Value = "DATE OF DEATH"
xlWS.Range("G1").Value = "COMMENTS"
xlWS.Range("H1").Value = "ORIGINAL ACCOUNT"
lngRow = 2
Do While Not RS.EOF
xlWS.Cells(lngRow, 1).Value = RS!CFG_ACCOUNT
xlWS.Cells(lngRow, 2).Value = RS!REASON
xlWS.Cells(lngRow, 3).Value = RS!BANKRUPTCYCHAPTE
xlWS.Cells(lngRow, 4).Value = RS!CASENUM
xlWS.Cells(lngRow, 5).Value = RS!BKTFILEDATE
xlWS.Cells(lngRow, 6).Value = RS!DATEOFDEATH
xlWS.Cells(lngRow, 7).Value = RS!Comments
xlWS.Cells(lngRow, 8).Value = RS!ORIGINALACCOUNT
lngRow = lngRow + 1
RS.movenext
Loop
xlWb.Close SaveChanges:=True
Set xlWb = Nothing
Set xlWS = Nothing
xlApp.Quit
Set xlApp = Nothing
Unload Me
ShellExecute 0, vbNullString, Chr(34) & strSource & Chr(34), vbNullString,
strSource, vbMaximizedFocus
End Sub
Private Sub Form_Load()
QueryProcess
End Sub