我想自動化複製記錄多達10,000個記錄並保存到csv文件

Question

我有一個excel文件，其中列名稱（EmailID，FirstName和Checksum）的50,000條記錄。我從它複製10,000條記錄並保存在一個csv文件中。我這樣做是爲了手動創建5個csv文件，即我將50,000條記錄分成10,000個記錄。

我想自動執行此項工作。我想寫一個宏，它將在特定位置創建csv文件。

Answer 1

如果幸運的話，你的數據是這樣的：

，你不需要在.CSVs別緻的格式，你可以逃脫使用.GetString（，cnStep。 ..）的記錄和一些正則表達式的修復行情，係爲例這個概念驗證腳本：

' want-to-automate-excel-work-of-copying-records-upto-10000-each-and-save-into-csv 

Option Explicit 

Const adClipString = 2 
Const cnStep  = 3 

Dim goFS : Set goFS = CreateObject("Scripting.FileSystemObject") 

WScript.Quit demoMain() 

Function demoMain() 
    demoMain = 0 ' assume success 

    Dim reClean : Set reClean = New RegExp 
    reClean.Global = True 
    reClean.Multiline = True 
    reClean.Pattern = """(\d+)$" 
    Dim reQuote : Set reQuote = New RegExp 
    reQuote.Global = True 
    reQuote.Multiline = True 
    reQuote.Pattern = "^(.)" 
    Dim sDDir : sDDir  = "..\Data\SplitToCsv" 
    Dim sXFSpec : sXFSpec  = goFS.BuildPath(sDDir, "SplitToCsv.xls") 
    Dim oXDb : Set oXDb = CreateObject("ADODB.Connection") 
    ' based on: !! http://www.connectionstrings.com/excel 
    oXDb.open Join(Array( _ 
     "Provider=Microsoft.Jet.OLEDB.4.0" _ 
     , "Data Source=" & sXFSpec   _ 
     , "Extended Properties="""   _ 
      & Join(Array( _ 
       "Excel 8.0" _ 
       , "HDR=Yes" _ 
       , "IMEX=1" _ 
      ), ";")  _ 
      & """"   _ 
), ";") 
    Dim oRs : Set oRs = oXDb.Execute("SELECT * FROM [Everybody]") 
    Dim sFs : sFs  = getRsFNames(oRs) 
    Dim nR : nR  = 1 
    Do Until oRs.EOF 
    Dim s : s = reQuote.Replace(_ 
         reClean.Replace(_ 
          oRs.GetString(adClipString, cnStep, """,""", vbCrLf) _ 
         , "$1" _ 
        ) _ 
        , """$1" _ 
       ) 
    Dim f : f = goFS.BuildPath(sDDir, "R" & nR & "ff.csv") 
    WScript.Echo f 
    WScript.Echo s 
    goFS.CreateTextFile(f, True).Write sFs & vbCrLf & s 
    nR = nR + cnStep 
    Loop 

    oXDb.Close 

    WScript.Echo goFS.OpenTextFile(f).ReadAll() 
End Function ' demoMain 

Function getRsFNames(oRs) 
    ReDim a(oRs.Fields.Count - 1) 
    Dim f 
    For f = 0 To UBound(a) 
     a(f) = """" & oRs.Fields(f).Name & """" 
    Next 
    getRsFNames = Join(a, ",") 
End Function ' getRsFNames 

輸出：

cscript 10780869.vbs 
..\Data\SplitToCsv\R1ff.csv 
"EM1","FN1",1 
"EM2","FN2",2 
"EM3","FN3",3 

..\Data\SplitToCsv\R4ff.csv 
"EM4","FN4",4 
"EM5","FN5",5 
"EM6","FN6",6 

..\Data\SplitToCsv\R7ff.csv 
"EM7","FN7",7 

"EmailID","FirstName","Checksum" 
"EM7","FN7",7 

我試圖讓你輕鬆修補連接字符串;取決於您的安裝，您可能需要更改版本號和/或屬性名稱。

您可能會注意到圖片中的「OpenOffice」 - 這是這種方法的一個優點：即使在沒有Excel的計算機上也可以運行。

評分：我寫了這個答案，當問題仍然標記爲vbscript。