[英]Convert Xls to Csv for a Range of Cells
我有一個VBA宏,可以將文件夾中存在的所有.xls文件轉換為.csv文件,但是還有一些其他要求需要完成。
我必須選擇一系列列(例如從A到AQ以及所有行),然后將它們保存到.CSV文件中,我通過宏錄制嘗試了一下,但沒有幫助。
Sub ConvertXLStoCSVNoRules(mySourcePath)
Set MyObject = New Scripting.FileSystemObject
Set strInputFolder = MyObject.GetFolder(mySourcePath)
'Set strOutputFolder = MyObject.GetFolder(myKeywordPath)
'Call DelFolder
strInputFolder = strInputFolder & "\"
MkDir (ThisWorkbook.Path & "\Sales")
MkDir (ThisWorkbook.Path & "\Group")
strOutputFolderGroup = ThisWorkbook.Path & "\Group\"
strOutputFolderSales = ThisWorkbook.Path & "\Sales\"
strXLSFile = Dir(strInputFolder & "*.xls*")
counter = 0
row = 24
Worksheets("Main").Cells(row, 1).Value = "Files processed at " & Now
row = row + 1
On Error Resume Next
Do While strXLSFile <> ""
counter = counter + 1
row = row + 1
If InStr(1, strXLSFile, "Sales") <> 0 Then
'strCSVFile contains Sales Then
'strCSVFile = Left(strXLSFile, InStrRev(strXLSFile, ".")) & "csv"
On Error Resume Next
strCSVFile = Left(strXLSFile, 4) & " Sales" & ".csv"
'Add into the first sheet for recording purpose
Worksheets("Main").Cells(row, 1).Value = strXLSFile
Workbooks.OpenText strInputFolder & strXLSFile
Range("A1:AQ1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs strOutputFolderSales & strCSVFile, xlCSV, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = False
ActiveWorkbook.Close False
strXLSFile = Dir
ElseIf InStr(1, strXLSFile, "Group") <> 0 Then
strCSVFile = Left(strXLSFile, 4) & " Group" & ".csv"
'Add into the first sheet for recording purpose
Worksheets("Main").Cells(row, 1).Value = strXLSFile
Workbooks.OpenText strInputFolder & strXLSFile
Range("A1:AQ1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs strOutputFolderSales & strCSVFile, xlCSV, CreateBackup:=False
ActiveWindow.Close
Application.DisplayAlerts = False
ActiveWorkbook.Close False
strXLSFile = Dir
Else
Worksheets("Main").Cells(row, 1).Value = strXLSFile & " Not Processed"
End If
Loop
'MsgBox ("Files completed " & counter)
row = row + 1
Worksheets("Main").Cells(row, 1).Value = "Files completed " & counter & " at " & Now
End Sub
執行代碼時沒有錯誤。 數據不會從excel文件復制到.csv文件。 打開用於復制的Excel文件不會關閉。
任何解決方案都將有所幫助
評論:
我有完整的代碼塊,現在包含xls文件的文件夾在轉換為csv后將根據名稱作為sales和group進行分隔,但是轉換后的csv文件的大小為1kb,除了很少的垃圾外沒有任何數據。
提前致謝
您當前選擇的是最后一行而不是所有行。 您可以編寫Range("A1:AQ" & lnDyRw).select
,它將選擇A1和AQ lnDyRw之間的所有內容
或者選擇要編寫的列范圍: Range("A:AQ").select
目前,您應該在新工作簿中的最后一行。
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.