注入代码将所有列格式化为文本，以保留CSV中的前导零

所以这里是一个3部分的macros的一部分，可以让你浏览到一个文件夹，并巩固/转置/保留一堆.csv文件的标题。 我们遇到的问题是在哪里注入一些代码，以便路由和帐号被格式化为文本并保留其前导零。 如果最简单的解决scheme是将整个表格格式化为文本格式，那么这对我们来说是可行的…不pipe需要什么，都不需要详细说明，因为这些信息不会总是在同一列。

提前致谢！

Option Explicit 'Set a public constant variable Public Const DNL As String = vbNewLine & vbNewLine Sub ImportData() 'Declare all variables Dim wb As Workbook, ws As Worksheet Dim wbX As Workbook, wsX As Worksheet Dim i As Long, iRow As Long, iFileNum As Long, sMsg As String Dim vFolder As Variant, sSubFolder As String, sFileName As String Dim bOpen As Boolean 'Turn off some application-level events to improve code efficiency Call TOGGLEEVENTS(False) 'Have the user choose the folder vFolder = BrowseForFolder() 'Exit if nothing was chosen, variable will be False If vFolder = False Then Exit Sub 'Check if this is what the user wants to do, confirm with a message box, exit if no sMsg = "Are you sure you want to import data from this folder:" sMsg = sMsg & DNL & vFolder If MsgBox(sMsg, vbYesNo + vbDefaultButton2, "ARE YOU SURE?") <> vbYes Then Exit Sub 'Set sub-folder as variable for save name at end of routine sSubFolder = Right(vFolder, Len(vFolder) - InStrRev(vFolder, Application.PathSeparator)) 'Set destination file with one worksheet Set wb = Workbooks.Add(xlWBATWorksheet) Set ws = wb.Sheets(1) 'This will be the row to start data on, to incriment in loop iRow = 2 'Loop through files in folder sFileName = Dir$(vFolder & "\") Do Until sFileName = "" 'Check that the file pattern matches what you want, ie 12.16.00.xls If sFileName Like "*.csv" Then '### set file extension here 'Check to see if the file is open 'If file is open, set as variable, if not, open and set as variable If ISWBOPEN(sFileName) = True Then Set wbX = Workbooks(sFileName) bOpen = True Else Set wbX = Workbooks.Open(vFolder & "\" & sFileName) bOpen = False End If 'Set first sheet in target workbok as worksheet variable, from which to mine data Set wsX = wbX.Sheets(1) 'Get last row from column A (range for copy/pasting) i = wsX.Cells(wsX.Rows.Count, 1).End(xlUp).Row 'Check if a file has been added, if not add headers (frequency) If iFileNum = 0 Then ws.Range("B1", ws.Cells(1, i + 1)).Value = Application.Transpose(wsX.Range("A1:A" & i)) End If 'Add data ws.Range("B" & iRow, ws.Cells(iRow, i + 1)).Value = Application.Transpose(wsX.Range("B1:B" & i)) 'Add file name to column A ws.Range("A" & iRow).Value = "'" & Left$(sFileName, Len(sFileName) - 4) 'Incriment variable values iRow = iRow + 1 iFileNum = iFileNum + 1 'If file was closed to start with, clean up and close it If bOpen = False Then wbX.Close SaveChanges:=False End If 'Get next file name sFileName = Dir$() Loop 'Check if file name to save exists If Dir$(vFolder & "\" & sSubFolder & ".xls", vbNormal) = "" Then wb.SaveAs vFolder & "\" & sSubFolder & ".xls" MsgBox "Complete!", vbOKOnly Else MsgBox "File already exists! File is NOT saved!", vbInformation, "COMPLETE!" End If 'Reset events back to application defaults Call TOGGLEEVENTS(True) End Sub