尝试使用VBA将固定宽度的文本文件导入到Excel中

我是VBA新手，希望能帮助实现一个用户定义的函数。 我真的很感激任何帮助！

上下文 ：我试图将一批固定宽度的文本文件导入到单独的Excel工作簿中。 文本文件都具有相同的字段和格式。 我知道每个领域的长度。

问题 ：由于我是VBA的新手，我查找了现有的代码。 我发现Chip Pearson的ImportFixedWidth函数 ，并试图按照他的描述来实现它。 首先，我复制他的示例macros，调用ImportFixedWidth函数，并对其进行编辑，以反映每个数据字段的数量和长度。 我称之为模块TestImport 。

Sub TestImport() Dim L As Long L = ImportFixedWidth(FileName:="/Users/gitanjali/Desktop/CAC06075test.txt", _ StartCell:=Range("A1"), _ IgnoreBlankLines:=False, _ SkipLinesBeginningWith:=vbNullString, _ FieldSpecs:="1,5|2,45|3,3|4,45|5,45|6,45|7,60|8,15|9,11|10,60| _ 11,60|12,10|13,5|14,5|15,3|16,3|17,3|18,3|19,11|20,10| ...190,250|191,250") End Sub 

然后，我将他的ImportFixedWidth代码复制到另一个模块（Module2，请参阅本文后面的代码块）。

然后我尝试运行工作簿中的macros，但它似乎不工作 – 也就是说，ImportFixedWidth函数应该返回导入的logging数（如果有效）或-1（如果不是）。 当我从工作簿运行TestImport时， 不会返回任何内容 – 工作簿保持空白。

debugging ：代码编译，当我通过TestImport或Module2代码时，我没有得到任何错误。

问题 ：我在debugging方面的后续步骤中处于亏损状态。 在我的实现中是否有任何明显的错误，或者我如何运行macros？

  Function ImportFixedWidth(FileName As String, _ StartCell As Range, _ IgnoreBlankLines As Boolean, _ SkipLinesBeginningWith As String, _ ByVal FieldSpecs As String) As Long ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ImportFixedWidth ' By Chip Pearson, [e-mail] www.cpearson.com ' Date: 27-August-2011 ' Compatible with 64-bit platforms. ' ' This function imports text from a fixed field width file. ' FileName is the name of the file to import. StartCell is ' the cell in which the import is to begin. IgnoreBlankLines ' indicates what to do with empty lines in the text file. If ' IgnoreBlankLines is False, an empty row will appear in the ' worksheet. If IgnoreBlankLines is True, no empty row will ' appear in the worksheet. SkipLinesBeginingWith indicates ' what character, if any, at the begining of the line indicates ' that the line should not be imported, such as fpr providing for ' comments within the text file. FieldSpecs indicates how to ' map the data into cells. It is a string of the format: ' start,length|start,length|start,length... ' where each 'start' is the character position of the field ' in the text line and each 'length' is the length of the field. ' For example, if FieldSpecs is ' 1,8|9,3|12,5 ' indicates the first field starting in position 1 for a ' length of 8, the second field starts in position 9 for a ' length of 3, and finally a field beginning in position 12 ' for a length of 5. Fields can be in any order and may ' overlap. ' You can specify a number format for the field which will ' be applied to the worksheet cell. This format should not ' be in quotes and should follow the length element. For example, ' 2,8|9,3,@|12,8,dddd dd-mmm-yyyy ' This specifies that no formatting will be applied to column 2, ' the Text (literal) format will be applied to column 9, and ' the format 'dddd dd-mmm-yyyy' will be applied to column 12. ' ' The function calls ImportThisLine, which should return ' True to import the text from the file, or False to skip ' the current line. ' This function returns the number of records imported if ' successful or -1 if an error occurred. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim FINdx As Long Dim C As Long Dim R As Range Dim FNum As Integer Dim S As String Dim RecCount As Long Dim FieldInfos() As String Dim FInfo() As String Dim N As Long Dim T As String Dim B As Boolean Application.EnableCancelKey = xlInterrupt On Error GoTo EndOfFunction: If Dir(FileName, vbNormal) = vbNullString Then ' file not found ImportFixedWidth = -1 Exit Function End If If Len(FieldSpecs) < 3 Then ' invalid FieldSpecs ImportFixedWidth = -1 Exit Function End If If StartCell Is Nothing Then ImportFixedWidth = -1 Exit Function End If Set R = StartCell(1, 1) C = R.Column FNum = FreeFile Open FileName For Input Access Read As #FNum ' get rid of any spaces FieldSpecs = Replace(FieldSpecs, Space(1), vbNullString) ' omit double pipes || N = InStr(1, FieldSpecs, "||", vbBinaryCompare) Do Until N = 0 FieldSpecs = Replace(FieldSpecs, "||", "|") N = InStr(1, FieldSpecs, "||", vbBinaryCompare) Loop ' omit double commas N = InStr(1, FieldSpecs, ",,", vbBinaryCompare) Do Until N = 0 FieldSpecs = Replace(FieldSpecs, ",,", ",") N = InStr(1, FieldSpecs, ",,", vbBinaryCompare) Loop ' get rid of leading and trailing | characters, if necessary If StrComp(Left(FieldSpecs, 1), "|", vbBinaryCompare) = 0 Then FieldSpecs = Mid(FieldSpecs, 2) End If If StrComp(Right(FieldSpecs, 1), "|", vbBinaryCompare) = 0 Then FieldSpecs = Left(FieldSpecs, Len(FieldSpecs) - 1) End If Do ' read the file Line Input #FNum, S If SkipLinesBeginningWith <> vbNullString And _ StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), _ SkipLinesBeginningWith, vbTextCompare) Then If Len(S) = 0 Then If IgnoreBlankLines = False Then Set R = R(2, 1) Else ' do nothing End If Else ' allow code to change the FieldSpecs values If FieldSpecs = vbNullString Then ' FieldSpecs is empty. Do nothing, don't import. Else If ImportThisLine(S) = True Then FieldInfos = Split(FieldSpecs, "|") C = R.Column For FINdx = LBound(FieldInfos) To UBound(FieldInfos) FInfo = Split(FieldInfos(FINdx), ",") R.EntireRow.Cells(1, C).Value = Mid(S, CLng(FInfo(0)), CLng(FInfo(1))) C = C + 1 Next FINdx RecCount = RecCount + 1 End If Set R = R(2, 1) End If End If Else ' no skip first char End If Loop Until EOF(FNum) EndOfFunction: If Err.Number = 0 Then ImportFixedWidth = RecCount Else ImportFixedWidth = -1 End If Close #FNum End Function Private Function ImportThisLine(S As String) As Boolean Dim N As Long Dim NoImportWords As Variant Dim T As String Dim L As Long NoImportWords = Array("page", "product", "xyz") For N = LBound(NoImportWords) To UBound(NoImportWords) T = NoImportWords(N) L = Len(T) If StrComp(Left(S, L), T, vbTextCompare) = 0 Then ImportThisLine = False Exit Function End If Next N ImportThisLine = True End Function 

Answer 1

在你所发布的function中，你有一个错误

 FieldSpecs:="1,5|2,45|3,3|4,45|5,45|6,45|7,60|8,15|9,11|10,60| _ 11,60|12,10|13,5|14,5|15,3|16,3|17,3|18,3|19,11|20,10| ...190,250|191,250") 

因为你不能在一个string中有一个连续字符，而仍然把它当作一个连续字符。 因为这会停止你的代码编译，我认为这是不是在你的实际代码。

---

Chip Pearson在他的function上有一个错误。 行说

 If SkipLinesBeginningWith <> vbNullString And _ StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), _ SkipLinesBeginningWith, vbTextCompare) Then 

如果SkipLinesBeginningWithvariables是空string，将会排除处理的所有行

• SkipLinesBeginningWith <> vbNullString将为False ，并且
• StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), SkipLinesBeginningWith, vbTextCompare)部分将返回0 ，相当于False 。

实际上应该是

 If SkipLinesBeginningWith = vbNullString Or _ StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), _ SkipLinesBeginningWith, vbTextCompare) Then