請教
If Trim(Text1.Text) = "" Or Trim(Text2.Text) = "" ThenMsgBox "條件不可為空"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If
Frame1.Enabled = False
Set objrs1 = Nothing
strquery = "select aa,bb,cc from t_abc where cc BETWEEN '" & Text1.Text & "' AND '" & Text2.Text & "'"
objrs1.Open strquery, objcn, adOpenKeyset, adLockOptimistic
Dim rstCount As Long '記錄行數
Dim rstField As Long '記錄列數
rstCount = objrs1.RecordCount
rstField = objrs1.Fields.Count
If rstCount <= 0 Then
Frame1.Enabled = True
MsgBox "nothing,check,please...!"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
Exit Sub
End If
Dim mExApp As Excel.Application '應用
Dim mExBook As Excel.Workbook '工作薄
Dim mExSheet As Excel.Worksheet '工作表
Set mExApp = CreateObject("Excel.Application")
Set mExBook = mExApp.Workbooks.Open(App.Path & "\abc.xls")
Set mExSheet = mExBook.Worksheets(1)
Dim lLine As Long
Dim Column As Long
Dim sCellValue As String
lLine = 1
'寫列頭
For Column = 0 To rstField
Select Case Column
Case 0
sCellValue = "aa"
Case 1
sCellValue = "bb"
Case 2
sCellValue = "cc"
End Select
mExSheet.Cells(lLine, Column + 1) = sCellValue
Next Column
'開始內容
For lLine = 2 To rstCount + 1
For Column = 0 To rstField
sCellValue = objrs1.Fields(Column + 4)
mExSheet.Cells(lLine, Column + 1) = sCellValue
Next Column
objrs1.MoveNext '下一行數據
Next lLine
'自動調整列
For Column = 1 To rstField
mExSheet.Columns(Column).AutoFit
Next
'輸出該表
objrs1.Requery
mExBook.SaveAs (Trim(objrs1.Fields(1)) & "-" & Trim(objrs1.Fields(3)) & ".xls") '保存
mExBook.Close (True) '按內容變化關閉
MsgBox "轉換成功!"
Frame1.Enabled = True
Text1 = "": Text2 = ""
Text1.SetFocus
想知道我那里出了錯幫忙調試一下
[[it] 本帖最后由 jxyga111 于 2008-6-7 09:30 编辑 [/it]]
