如何在宏中保存excel记录，然后再转换为csv

mtb9vblg 于 2022-12-24 发布在其他

关注(0)|答案(1)|浏览(155)

我有vba宏（GetData），从sql中获取一些记录，将其放入表中，然后调用另一个宏（ConvertToCsv）将表转换为csv格式。
我的问题是csv文件缺少一些记录。
如果我运行转换宏，在GetData宏结束后，没有问题。
问题就在我调用GetData宏内部的Convert宏时。
代码示例：
获取记录宏

Sub getData()
.
.
    comm.CommandText = _
            "SELECT x, y, z FROM A"
    rec.Open comm
    
    If rec.EOF = True Then 'Check if there is any records
        MsgBox ("There is no records")
        Exit Sub
    End If
    
    row = 1
    col = 1
    Do While Not rec.EOF
        WirteRecordsToSheets rec row col
        col = 1
        row = row + 1
        rec.MoveNext
    Loop

    ActiveWorkBook.save
    call ConvertToCsv

End Sub

Sub ConvertToCsv()
    fRow = 1
    fCol = 1
    lCol = 20
    filePath = "C:\aaa\bbb\"
    fileName = "file.csv"

    MakeDirectory filePath

    Worksheets("1").Select
    Set rng = Range(Cells(fRow, fCol), Cells(lRow, lCol))
    rng.Value = Application.Trim(rng)
  
    Set cpFromWB = ActiveWorkbook
    ' Set range to copy
    With cpFromWB
        'set the selected range
        Set cpFromRng = Range(Cells(fRow, fCol), Cells(lRow, lCol))
    End With
    ' Create new workbook
    Set cpToWB = Workbooks.Add
    Set cpToRng = cpToWB.ActiveSheet.Range("A1")

    'Copy everything over to the new workbook
    cpFromRng.Copy Destination:=cpToRng

    ' Save as CSV-file
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs fileName:=filePath & fileName, FileFormat:=xlCSV, CreateBackup:=False
    ActiveWorkbook.Close savechanges:=True
    Application.DisplayAlerts = True
    MsgBox ("the csv file named: " & fileName & " has successfully saved in the path: " & filePath)
End Sub

WirteRecordsToSheets(rec As Recordset, ByVal xlCol As Integer, ByVal xlRow As Integer)
    Worksheets("1").Select
    
    Cells(xlRow, xlCol).NumberFormat = "@"
    Cells(xlRow, xlCol).Value = Trim(rec("x"))
    
    xlCol = xlCol + 1 
    Cells(xlRow, xlCol).NumberFormat = "@"
    Cells(xlRow, xlCol).Value = Trim(rec("y"))

    xlCol = xlCol + 1 
    Cells(xlRow, xlCol).NumberFormat = "@"
    Cells(xlRow, xlCol).Value = Trim(rec("z"))
End Sub

excel

来源：https://stackoverflow.com/questions/74895175/how-to-save-excel-records-inside-macro-before-convert-to-csv

1条答案

按热度按时间

8xiog9wr1#

使用CopyFromRecordset方法。

Option Explicit

Sub getData()

    Dim conn As ADODB.Connection, rec As ADODB.Recordset
    Dim wb As Workbook, ws As Worksheet
    
    Const FOLDER = "C:\temp\bbb\"
    Const CSVNAME = "file.csv"
    
    ' connect to db
    Set conn = connectdb("test.accdb")
    
    ' get records from db
    Set rec = conn.Execute("SELECT TRIM(x),TRIM(y),TRIM(z) FROM A")
    
    If rec.EOF = True Then 'Check if any records
        MsgBox ("There are no records")
        Exit Sub
    Else
    
        MakeDirectory FOLDER
        ' copy records to new workbook
        Set wb = Workbooks.Add
        Set ws = wb.Sheets(1)
        With ws
           .Range("A:C").NumberFormat = "@"
           .Range("A1").CopyFromRecordset rec
           ' save as csv
           Application.DisplayAlerts = False
           .SaveAs filename:=FOLDER & CSVNAME, FileFormat:=xlCSV, CreateBackup:=False
           Application.DisplayAlerts = True
        End With
        
        wb.Close savechanges:=False
        MsgBox ("the csv file named: " & CSVNAME & _
        " has successfully saved in the path: " & FOLDER), vbInformation
            
    End If
    conn.Close

End Sub

Sub MakeDirectory(s)
    Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(s) Then fso.createFolder s
End Sub

Function connectdb(s As String) As ADODB.Connection
    Set connectdb = New ADODB.Connection
    connectdb.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & s
End Function

赞(0）回复(0）举报 2022-12-24

我来回答

如何在宏中保存excel记录，然后再转换为csv

1条答案

相关问题

热门标签

最新问答