将Xls转换为Csv以获取一系列单元格

时间:2014-03-19 06:43:19

标签: excel vba excel-vba csv vbscript

我有一个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,除了少量垃圾之外没有任何数据。

提前致谢

1 个答案:

答案 0 :(得分:0)

您当前选择的是最后使用的行而不是所有行。你可以写 Range("A1:AQ" & lnDyRw).select将选择A1和AQ之间的所有内容lnDyRw

或选择您可以编写的列范围: Range("A:AQ").select

此刻,您应该在新工作簿中的某个位置使用最后一行。