CSV 文件转换器在保存时使用 VBA 错误
CSV file converter using VBA error when saved
下面的代码用于将 CSV 文件转换为 excel 表格形式。
问题是在保存整个工作簿时（MACRO-ENABLED EXCEL FORM），问题就开始了。当工作簿是新的并且当我复制粘贴程序并 运行 它而不保存它时，程序 运行 很好但是在保存它供以后使用之后，程序将无法完成它的工作。当我 运行 它时没有错误消息。它只是不做它所做的。
Option Explicit
Sub ImportFile()
Dim sPath As String
Dim intChoice As Integer
Dim strPath As String
Dim FilePath As String
'change the display name of the open file dialog
Application.FileDialog(msoFileDialogOpen).Title = _
"CSV File Opener"
'Remove all other filters
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
'Add a custom filter
Call Application.FileDialog(msoFileDialogOpen).Filters.Add( _
"CSV Files Only", "*.csv")
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
Cells(7, 7) = strPath
Else
MsgBox "Wrong CSV File. Please Choose Again"
End If
'Below we assume that the file, csvtest.csv,
'is in the same folder as the workbook. If
'you want something more flexible, you can
'use Application.GetOpenFilename to get a
'file open dialogue that returns the name
'of the selected file.
'On the page Fast text file import
'I show how to do that - just replace the
'file pattern "txt" with "csv".
sPath = ThisWorkbook.Path & strPath
'Procedure call. Semicolon is defined as separator,
'and data is to be inserted on "Sheet2".
'Of course you could also read the separator
'and sheet name from the worksheet or an input
'box. There are several options.
copyDataFromCsvFileToSheet sPath, ";", "Sheet2"
End Sub
'**************************************************************
Private Sub copyDataFromCsvFileToSheet(parFileName As String, _
parDelimiter As String, parSheetName As String)
Dim Data As Variant 'Array for the file values
'Function call - the file is read into the array
Data = getDataFromFile(parFileName, parDelimiter)
'If the array isn't empty it is inserted into
'the sheet in one swift operation.
If Not isArrayEmpty(Data) Then
'If you want to operate directly on the array,
'you can leave out the following lines.
With Sheets(parSheetName)
'Delete any old content
.Cells.ClearContents
'A range gets the same dimensions as the array
'and the array values are inserted in one operation.
.Cells(1, 1).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End With
End If
End Sub
Public Function isArrayEmpty(parArray As Variant) As Boolean
'Returns False if not an array or a dynamic array
'that hasn't been initialised (ReDim) or
'deleted (Erase).
If IsArray(parArray) = False Then isArrayEmpty = True
On Error Resume Next
If UBound(parArray) < LBound(parArray) Then
isArrayEmpty = True
Exit Function
Else
isArrayEmpty = False
End If
End Function
'**************************************************************
Private Function getDataFromFile(parFileName As String, _
parDelimiter As String, _
Optional parExcludeCharacter As String = "") As Variant
'parFileName is the delimited file (csv, txt ...)
'parDelimiter is the separator, e.g. semicolon.
'The function returns an empty array, if the file
'is empty or cannot be opened.
'Number of columns is based on the line with most
'columns and not the first line.
'parExcludeCharacter: Some csv files have strings in
'quotations marks ("ABC"), and if parExcludeCharacter = """"
'quotation marks are removed.
Dim locLinesList() As Variant 'Array
Dim locData As Variant 'Array
Dim i As Long 'Counter
Dim j As Long 'Counter
Dim locNumRows As Long 'Nb of rows
Dim locNumCols As Long 'Nb of columns
Dim fso As Variant 'File system object
Dim ts As Variant 'File variable
Const REDIM_STEP = 10000 'Constant
'If this fails you need to reference Microsoft Scripting Runtime.
'You select this in "Tools" (VBA editor menu).
Set fso = CreateObject("Scripting.FileSystemObject")
On Error GoTo error_open_file
'Sets ts = the file
Set ts = fso.OpenTextFile(parFileName)
On Error GoTo unhandled_error
'Initialise the array
ReDim locLinesList(1 To 1) As Variant
i = 0
'Loops through the file, counts the number of lines (rows)
'and finds the highest number of columns.
Do While Not ts.AtEndOfStream
'If the row number Mod 10000 = 0
'we redimension the array.
If i Mod REDIM_STEP = 0 Then
ReDim Preserve locLinesList _
(1 To UBound(locLinesList, 1) + REDIM_STEP) As Variant
End If
locLinesList(i + 1) = Split(ts.ReadLine, parDelimiter)
j = UBound(locLinesList(i + 1), 1) 'Nb of columns in present row
'If the number of columns is then highest so far.
'the new number is saved.
If locNumCols < j Then locNumCols = j
i = i + 1
Loop
ts.Close 'Close file
locNumRows = i
'If number of rows is zero
If locNumRows = 0 Then Exit Function
ReDim locData(1 To locNumRows, 1 To locNumCols + 1) As Variant
'Copies the file values into an array.
'If parExcludeCharacter has a value,
'the characters are removed.
If parExcludeCharacter <> "" Then
For i = 1 To locNumRows
For j = 0 To UBound(locLinesList(i), 1)
If Left(locLinesList(i)(j), 1) = parExcludeCharacter Then
If Right(locLinesList(i)(j), 1) = parExcludeCharacter Then
locLinesList(i)(j) = _
Mid(locLinesList(i)(j), 2, Len(locLinesList(i)(j)) - 2)
Else
locLinesList(i)(j) = _
Right(locLinesList(i)(j), Len(locLinesList(i)(j)) - 1)
End If
ElseIf Right(locLinesList(i)(j), 1) = parExcludeCharacter Then
locLinesList(i)(j) = _
Left(locLinesList(i)(j), Len(locLinesList(i)(j)) - 1)
End If
locData(i, j + 1) = locLinesList(i)(j)
Next j
Next i
Else
For i = 1 To locNumRows
For j = 0 To UBound(locLinesList(i), 1)
locData(i, j + 1) = locLinesList(i)(j)
Next j
Next i
End If
getDataFromFile = locData
Exit Function
error_open_file: 'Returns empty Variant
unhandled_error: 'Returns empty Variant
End Function
你的 sPath 值是双路径值，第一个路径是你的工作簿本身，第二个路径是 csv 路径.. sPath 变量应该是 sPath = strPath 因为要尝试打开的文件只是 csv 文件。在保存工作簿之前，sPath 没问题，因为工作簿路径为空，sPath 的值只是 csv 路径，将工作簿保存到文件后，工作簿具有路径文件。
所以只是 edit sPath = ThisWorkbook.Path & strPath 到 sPath = strPath
下面的代码用于将 CSV 文件转换为 excel 表格形式。
问题是在保存整个工作簿时（MACRO-ENABLED EXCEL FORM），问题就开始了。当工作簿是新的并且当我复制粘贴程序并 运行 它而不保存它时，程序 运行 很好但是在保存它供以后使用之后，程序将无法完成它的工作。当我 运行 它时没有错误消息。它只是不做它所做的。
Option Explicit
Sub ImportFile()
Dim sPath As String
Dim intChoice As Integer
Dim strPath As String
Dim FilePath As String
'change the display name of the open file dialog
Application.FileDialog(msoFileDialogOpen).Title = _
"CSV File Opener"
'Remove all other filters
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
'Add a custom filter
Call Application.FileDialog(msoFileDialogOpen).Filters.Add( _
"CSV Files Only", "*.csv")
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
Cells(7, 7) = strPath
Else
MsgBox "Wrong CSV File. Please Choose Again"
End If
'Below we assume that the file, csvtest.csv,
'is in the same folder as the workbook. If
'you want something more flexible, you can
'use Application.GetOpenFilename to get a
'file open dialogue that returns the name
'of the selected file.
'On the page Fast text file import
'I show how to do that - just replace the
'file pattern "txt" with "csv".
sPath = ThisWorkbook.Path & strPath
'Procedure call. Semicolon is defined as separator,
'and data is to be inserted on "Sheet2".
'Of course you could also read the separator
'and sheet name from the worksheet or an input
'box. There are several options.
copyDataFromCsvFileToSheet sPath, ";", "Sheet2"
End Sub
'**************************************************************
Private Sub copyDataFromCsvFileToSheet(parFileName As String, _
parDelimiter As String, parSheetName As String)
Dim Data As Variant 'Array for the file values
'Function call - the file is read into the array
Data = getDataFromFile(parFileName, parDelimiter)
'If the array isn't empty it is inserted into
'the sheet in one swift operation.
If Not isArrayEmpty(Data) Then
'If you want to operate directly on the array,
'you can leave out the following lines.
With Sheets(parSheetName)
'Delete any old content
.Cells.ClearContents
'A range gets the same dimensions as the array
'and the array values are inserted in one operation.
.Cells(1, 1).Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End With
End If
End Sub
Public Function isArrayEmpty(parArray As Variant) As Boolean
'Returns False if not an array or a dynamic array
'that hasn't been initialised (ReDim) or
'deleted (Erase).
If IsArray(parArray) = False Then isArrayEmpty = True
On Error Resume Next
If UBound(parArray) < LBound(parArray) Then
isArrayEmpty = True
Exit Function
Else
isArrayEmpty = False
End If
End Function
'**************************************************************
Private Function getDataFromFile(parFileName As String, _
parDelimiter As String, _
Optional parExcludeCharacter As String = "") As Variant
'parFileName is the delimited file (csv, txt ...)
'parDelimiter is the separator, e.g. semicolon.
'The function returns an empty array, if the file
'is empty or cannot be opened.
'Number of columns is based on the line with most
'columns and not the first line.
'parExcludeCharacter: Some csv files have strings in
'quotations marks ("ABC"), and if parExcludeCharacter = """"
'quotation marks are removed.
Dim locLinesList() As Variant 'Array
Dim locData As Variant 'Array
Dim i As Long 'Counter
Dim j As Long 'Counter
Dim locNumRows As Long 'Nb of rows
Dim locNumCols As Long 'Nb of columns
Dim fso As Variant 'File system object
Dim ts As Variant 'File variable
Const REDIM_STEP = 10000 'Constant
'If this fails you need to reference Microsoft Scripting Runtime.
'You select this in "Tools" (VBA editor menu).
Set fso = CreateObject("Scripting.FileSystemObject")
On Error GoTo error_open_file
'Sets ts = the file
Set ts = fso.OpenTextFile(parFileName)
On Error GoTo unhandled_error
'Initialise the array
ReDim locLinesList(1 To 1) As Variant
i = 0
'Loops through the file, counts the number of lines (rows)
'and finds the highest number of columns.
Do While Not ts.AtEndOfStream
'If the row number Mod 10000 = 0
'we redimension the array.
If i Mod REDIM_STEP = 0 Then
ReDim Preserve locLinesList _
(1 To UBound(locLinesList, 1) + REDIM_STEP) As Variant
End If
locLinesList(i + 1) = Split(ts.ReadLine, parDelimiter)
j = UBound(locLinesList(i + 1), 1) 'Nb of columns in present row
'If the number of columns is then highest so far.
'the new number is saved.
If locNumCols < j Then locNumCols = j
i = i + 1
Loop
ts.Close 'Close file
locNumRows = i
'If number of rows is zero
If locNumRows = 0 Then Exit Function
ReDim locData(1 To locNumRows, 1 To locNumCols + 1) As Variant
'Copies the file values into an array.
'If parExcludeCharacter has a value,
'the characters are removed.
If parExcludeCharacter <> "" Then
For i = 1 To locNumRows
For j = 0 To UBound(locLinesList(i), 1)
If Left(locLinesList(i)(j), 1) = parExcludeCharacter Then
If Right(locLinesList(i)(j), 1) = parExcludeCharacter Then
locLinesList(i)(j) = _
Mid(locLinesList(i)(j), 2, Len(locLinesList(i)(j)) - 2)
Else
locLinesList(i)(j) = _
Right(locLinesList(i)(j), Len(locLinesList(i)(j)) - 1)
End If
ElseIf Right(locLinesList(i)(j), 1) = parExcludeCharacter Then
locLinesList(i)(j) = _
Left(locLinesList(i)(j), Len(locLinesList(i)(j)) - 1)
End If
locData(i, j + 1) = locLinesList(i)(j)
Next j
Next i
Else
For i = 1 To locNumRows
For j = 0 To UBound(locLinesList(i), 1)
locData(i, j + 1) = locLinesList(i)(j)
Next j
Next i
End If
getDataFromFile = locData
Exit Function
error_open_file: 'Returns empty Variant
unhandled_error: 'Returns empty Variant
End Function
你的 sPath 值是双路径值，第一个路径是你的工作簿本身，第二个路径是 csv 路径.. sPath 变量应该是 sPath = strPath 因为要尝试打开的文件只是 csv 文件。在保存工作簿之前，sPath 没问题，因为工作簿路径为空，sPath 的值只是 csv 路径，将工作簿保存到文件后，工作簿具有路径文件。
所以只是 edit sPath = ThisWorkbook.Path & strPath 到 sPath = strPath