如何在转换为csv之前保存Excel记录

thtygnil 于 2023-06-19 发布在其他

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

我有VBA宏（GetData），它从sql中获取记录，将其放入工作表中，然后调用另一个宏（ConvertToCsv），将工作表转换为csv格式。
如果我在GetData宏之后运行convert宏，则没有问题。
当我调用Convert宏时，GetData宏中csv文件丢失了一些记录。
获取记录宏

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

csv

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

1条答案

按热度按时间

uurv41yg1#

使用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）举报 2023-06-19

我来回答

如何在转换为csv之前保存Excel记录

1条答案

相关问题

热门标签

最新问答