在处理我的宏时,我很挣扎。我有一个数组(定义为Variant),我在其中放置了要导入到工作表的文件的名称。我有一个计数器(定义为Long)放置在For循环中以遍历所有数组的位置。 在浏览每个文件时,我调用一个函数来计算文件中的行数,以确保我不会导入超过1 excel表中允许的行数。我有一个第二个数组(再次定义为Variant),我想在打开的文件中存储这个行数。这个公共变量被定义为Long,当我尝试将值赋给数组时,我得到一个错误13“Type mismatch”。
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
File_To_Be_Checked = FilNams(FilNamCntr)
Call File_Lenght_Checker
FilNams_Rows(FilNamCntr) = File_To_Be_Checked_Rows '<< Here I get an error
Next FilNamCntr
您有什么建议我如何将Long变量中的数字分配给数组? 我只想要一个带有文件名的数组来打开文件,第二个数组的大小(行数nb)要在导入文件之前检查我在工作表中已经有多少行以及我是否可以将文件导入当前片材。
下面我附上一个完整的代码:
Option Explicit
Public Sub FileImport_Multiple()
Dim qry As QueryTable
Dim FilNams As Variant
Dim FilNams_Rows As Variant
Dim FilNamCntr As Long
Dim strQryName As String
Dim LastRow As Long
Dim ContainerWB As Workbook
Dim msgString As String
Dim RowCounter01 As Long
Dim RowCounter02 As Long
Dim wB As Workbook
FilNams = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt", _
Title:="Select text files to Import", _
MultiSelect:=True)
'===========================
'Defining a name of this sheet to variable and setting up a statusbar
'===========================
Tool_name = ActiveWorkbook.Name
Range("A1").Select
'Check to see if any files were selected
If TypeName(FilNams) = "Boolean" Then
MsgBox "No Files Selected. Exiting Program."
Exit Sub
Else
'msgString = Join(FilNams, vbCr)
'MsgBox "FilNams is: " & msgString
End If
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
File_To_Be_Checked = FilNams(FilNamCntr)
Call File_Lenght_Checker
FilNams_Rows(FilNamCntr) = File_To_Be_Checked_Rows
Next FilNamCntr
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
FilNams(FilNamCntr) = "TEXT;" & FilNams(FilNamCntr)
Next FilNamCntr
'msgString = Join(FilNams, vbCr)
'MsgBox "FilNams is: " & msgString
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
With ActiveSheet
On Error GoTo ErrorCatch:
RowCounter01 = .Cells(.Rows.Count, "D").End(xlUp).Row
'Append to previous data, if applicable
If .Range("D" & Rows.Count).End(xlUp).Row = 1 Then
LastRow = 1
Else
LastRow = .Range("D" & Rows.Count).End(xlUp).Row + 1
End If
If (RowCounter01 + FilNams_Rows(FilNamCntr)) >= 1048576 Then
MsgBox "Not enough space to import text files. Exiting.."
Exit Sub
End If
'MsgBox "LastRow value is:" & LastRow 'verification test
Set qry = .QueryTables.Add(Connection:=FilNams(FilNamCntr), _
Destination:=.Range("D" & LastRow))
With qry
.Name = "Filename"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 4, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End With
Next FilNamCntr
Exit Sub
ErrorCatch:
MsgBox "Unexpected Error. Type: " & Err.Description
End Sub
答案 0 :(得分:0)
OP解决方案。
我设法修改代码,以便宏现在正常工作。当定义为Long而不是Variant时,我忘了重新调整数组。这是更新的代码:
Option Explicit
Public Sub FileImport_Multiple()
Dim qry As QueryTable
Dim FilNams As Variant
Dim FilNams_Rows As Long '<< Changed here from Variant to Long
Dim FilNamCntr As Long
Dim strQryName As String
Dim LastRow As Long
Dim ContainerWB As Workbook
Dim msgString As String
Dim RowCounter01 As Long
Dim RowCounter02 As Long
Dim wB As Workbook
FilNams = Application.GetOpenFilename(FileFilter:="Text Files (*.txt),*.txt", _
Title:="Select text files to Import", _
MultiSelect:=True)
'===========================
'Defining a name of this sheet to variable and setting up a statusbar
'===========================
Tool_name = ActiveWorkbook.Name
Range("A1").Select
'Check to see if any files were selected
If TypeName(FilNams) = "Boolean" Then
MsgBox "No Files Selected. Exiting Program."
Exit Sub
Else
'msgString = Join(FilNams, vbCr)
'MsgBox "FilNams is: " & msgString
End If
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
ReDim Preserve FilNams_Rows(FilNamCntr) '<< Here I forgot to ReDim
File_To_Be_Checked = FilNams(FilNamCntr)
Call File_Lenght_Checker
FilNams_Rows(FilNamCntr) = File_To_Be_Checked_Rows
Next FilNamCntr
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
FilNams(FilNamCntr) = "TEXT;" & FilNams(FilNamCntr)
Next FilNamCntr
'msgString = Join(FilNams, vbCr)
'MsgBox "FilNams is: " & msgString
For FilNamCntr = LBound(FilNams) To UBound(FilNams)
With ActiveSheet
On Error GoTo ErrorCatch:
RowCounter01 = .Cells(.Rows.Count, "D").End(xlUp).Row
'Append to previous data, if applicable
If .Range("D" & Rows.Count).End(xlUp).Row = 1 Then
LastRow = 1
Else
LastRow = .Range("D" & Rows.Count).End(xlUp).Row + 1
End If
If (RowCounter01 + FilNams_Rows(FilNamCntr)) >= 1048576 Then
MsgBox "Not enough space to import text files. Exiting.."
Exit Sub
End If
'MsgBox "LastRow value is:" & LastRow 'verification test
Set qry = .QueryTables.Add(Connection:=FilNams(FilNamCntr), _
Destination:=.Range("D" & LastRow))
With qry
.Name = "Filename"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 4, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End With
Next FilNamCntr
Exit Sub
ErrorCatch:
MsgBox "Unexpected Error. Type: " & Err.Description
End Sub