Question

我正在尝试使用Excel VBA将AS400表格/文件中的数据直接导出到CSV文件。到目前为止，我有以下内容，但它逐行将输出写入CSV文件，并且标题似乎不包含在输出中。

我可以将数据输出到Excel并将其保存为CSV，但由于它超过100万行，我最终只得到了所需数量的一半。

如何将数据批量转储为CSV并包含标题？

Sub ExportCSV()

 Set Conn = CreateObject("adodb.connection")
 Set rcd = CreateObject("adodb.recordset")
 Set outFile = CreateObject("Scripting.FileSystemObject").CreateTextFile("H:\myFile.csv")
 cnnstr = "DRIVER={Client Access ODBC Driver (32-bit)};SYSTEM=TEST;USERID=123;PWD=123"

 Conn.Open cnnstr

 Set rcd.ActiveConnection = Conn

 sqlstm = "SELECT TEST50,LTEST50 FROM TESTLIB.TEST Where TEST50 Is Not NULL And LTEST50 Is Not NULL Order By TEST50 ASC "

 rcd.Open sqlstm

 rcd.MoveFirst

Do
  outFile.WriteLine rcd("TEST50") & "," & rcd("LTEST50")
  rcd.MoveNext

Loop Until rcd.EOF

  rcd.Close
  con.Close

 Set rcd = Nothing
 Set Conn = Nothing

End Sub

Answer 1

这是一种强力方法，我确信有更优雅的方法可以将大型文本文件加载到Excel中，例如Chip Pearson整理的文本：

http://www.cpearson.com/excel/ImportBigFiles.aspx

否则，蛮力方法可以让你开始：

Sub ExportCSV()

 Dim wb as Object 'Excel.Workbook
 Dim ws as Object 'Excel.Worksheet
 Dim r As Long    'row counter/iterator

 Set Conn = CreateObject("adodb.connection")
 Set rcd = CreateObject("adodb.recordset")
 Set outFile = CreateObject("Scripting.FileSystemObject").CreateTextFile("H:\myFile.csv")
 cnnstr = "DRIVER={Client Access ODBC Driver (32-bit)};SYSTEM=TEST;USERID=123;PWD=123"

 Conn.Open cnnstr

 Set rcd.ActiveConnection = Conn

 sqlstm = "SELECT TEST50,LTEST50 FROM TESTLIB.TEST Where TEST50 Is Not NULL And LTEST50 Is Not NULL Order By TEST50 ASC "

 rcd.Open sqlstm

 rcd.MoveFirst

 'Create a new/empty Excel file
 Set wb = CreateExcelFile()
 Set ws = wb.Worksheets(1) 
 r = 1
 'write the headers
 Call WriteData(ws, r, "TEST50,LTEST50")

 'Write the data
 Do
    If Not r > ws.Rows.Count Then
        Call WriteData(ws, r, rcd("TEST50") & "," & rcd("LTEST50"))
    Else
        'begin with r=1 on a new worksheet
        Set ws = wb.Worksheets.Add(After:=wb.Worksheets.Count)
        r = 1
        Call WriteData(ws, r, "TEST50,LTEST50")
    End If

 rcd.MoveNext

 Loop Until rcd.EOF

End Sub
Sub WriteData(ws as Object, r as Long, strData as String)
    With ws.Range("A" & r & ":B" & r)
        .Value = Split(strData, ",")
    End With
End Sub
Function CreateExcelFile() As Object
Dim xlApp as Object
Dim ret as Object

On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err.Number <> 0 Then Set xlApp = CreateObject("Excel.Application")
On Error GoTo 0

Set ret = xlApp.Workbooks.Add
Do Until ret.Worksheets.Count = 1
    ret.Worksheets(ret.Worksheets.Count).Delete
Loop

Set CreateExcelFile = ret
End Function

使用Excel VBA从AS400导入CSV

1 个答案: