如何自动'文字到列'并且'另存为'在VBA?

时间:2016-03-22 10:47:08

标签: excel vba excel-vba

我有一个源目录,其中有.csv文件(B1单元格)。还有一个目标目录,我将相同的文件保存为.xlsx(B2单元格),执行一些处理,如Text to Columns,选择分隔符等,如下所示的VBA宏。

Sub FileList()

Dim directory As String, fileName As String, saveas As String, fileNameXlsx As String
Dim file As Variant
Dim wb As Workbook, LastRow As Long, LastRow1 As Long
Dim i As Integer, j As Integer
Set wb = Workbooks("CSV_File.xlsm")
Application.ScreenUpdating = False

'Clear old data
LastRow = Sheets("FileList").Range("A" & Sheets("FileList").Rows.Count).End(xlUp).Row
Sheets("FileList").Select
Range("A1:A" & LastRow).Select
Selection.ClearContents

directory = wb.Sheets("Directory").Cells(1, 2).Value
saveas = wb.Sheets("Directory").Cells(2, 2).Value
file = Dir(directory & "*.csv")

While (file <> "")
i = i + 1
j = 1
wb.Sheets("FileList").Cells(i, j).Value = file
file = Dir
Wend

LastRow1 = Sheets("FileList").Range("A" & Sheets("FileList").Rows.Count).End(xlUp).Row
For i = 1 To LastRow1
On Error Resume Next
'.csv FileName
Range("B" & i).Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[-1],(LEN(RC[-1])-4))"
fileNameXlsx = wb.Sheets("FileList").Cells(i, 2).Value & ".xlsx"
fileName = wb.Sheets("FileList").Cells(i, 1).Value
'Open .xlsx file
Workbooks.Open (directory & fileName)
Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
        Comma:=True, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1)), DecimalSeparator:= _
        ",", ThousandsSeparator:=" ", TrailingMinusNumbers:=True
    ChDir saveas
    ActiveWorkbook.saveas fileNameXlsx _
    , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'Close .xlsx
Workbooks(fileNameXlsx).Close SaveChanges:=False
Next i

End Sub

除了宏每次到达以下事实外,它的效果非常好:

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
        Comma:=True, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1)), DecimalSeparator:= _
        ",", ThousandsSeparator:=" ", TrailingMinusNumbers:=True
    ChDir saveas

它向我显示以下消息,我需要确认它单击“确定”。 enter image description here

我想询问是否有任何方法可以自动跳过它(单击“确定”)? 感谢。

1 个答案:

答案 0 :(得分:0)

您可以添加

Applications.DisplayAlerts = False

位于宏的顶部,因此不会显示任何警报(根本不会!)。不要忘记在代码末尾将其设置为true。