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

本文介绍了尝试使用VBA将固定宽度的文本文件导入Excel的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我是VBA的新手，希望能够帮助您实现用户定义的功能。我真的非常感谢任何帮助！

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

问题：由于我是VBA新手，我寻找现有的代码。我发现，并一直在尝试实施它的描述。首先，我复制了他的示例宏调用 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）
结束子

然后，我将他的ImportFixedWidth代码复制到另一个模块中（Module2，参见本文末尾的代码块）。

然后，我尝试在工作簿中运行宏，但似乎不起作用 - 也就是说，ImportFixedWidth函数应该返回导入的记录数（如果它有效）或-1（如果没有）。当我从工作簿中运行TestImport时，没有返回任何 - 工作簿仍然为空。

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

问题：我在调试方面的下一步失败了。我的实现有什么明显的错误，还是我试图运行宏？函数ImportFixedWidth（FileName As String，_
StartCell As Range，_
IgnoreBlankLines As Boolean，_
SkipLinesBeginningWith As String，_
ByVal FieldSpecs As String）As Long
''''''''''''''''''' '''''''''''''''''''''''''''''''
'ImportFixedWidth
'By Chip Pearson，[email protected] www.cpearson.com
'日期：2011年8月27日
'兼容64位平台。
'
'此函数从固定字段宽度文件导入文本。
'FileName是要导入的文件的名称。 StartCell是
'要导入的单元格。 IgnoreBlankLines
'表示如何处理文本文件中的空行。如果
'IgnoreBlankLines为False，
'工作表中将显示一个空行。如果IgnoreBlankLines为True，则在工作表中不会有空行
'。 SkipLinesBeginingWith表示
'在行开头的什么字符（如果有的话）表示
'不应该导入该行，例如在文本文件中提供
'注释的fpr。 FieldSpecs指示如何
'将数据映射到单元格中。它是一个格式的字符串：
'开始，长度|开始，长度|开始，长度...
'其中每个'开始'是字段的字符位置
'文本行和每个长度是字段的长度。
'例如，如果FieldSpecs是
'1,8 | 9,3 | 12,5
'表示在
'长度为8的位置1开始的第一个字段，第二个字段从位置9开始，
'长度为3，最后一个字段从位置12
'开始，长度为5.字段可以是任何顺序，可以是
' 交叠。
'您可以为
'应用于工作表单元格的字段指定一个数字格式。这个格式不应该是
'在引号中，应该遵循length元素。例如，
'2,8 | 9,3，@ | 12,8，dddd dd-mmm-yyyy
'这表示没有格式化将应用于列2
'文本（文字）格式将应用于第9列，
'格式'dddd dd-mmm-yyyy'将应用于第12列。
'
'该函数调用ImportThisLine ，应该返回
'True从文件导入文本，或者False跳过
'当前行。
'如果
成功，则此函数返回导入的记录数，如果发生错误，则返回-1。
'''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''$'
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
错误GoTo EndOfFunction：

如果Dir（FileName，vbNormal）= vbNullString Then
'文件未找到
ImportFixedWidth = -1
退出函数
如果

如果Len（FieldSpecs）< 3然后
'无效FieldSpecs
ImportFixedWidth = -1
退出函数
结束如果

如果StartCell不是，然后
ImportFixedWidth = -1
退出函数
如果

设置R = StartCell（1，1）
C = R.Column
FNum = FreeFile

打开FileName输入访问Read As #FNum
'摆脱任何空格
FieldSpecs =替换（FieldSpecs，Space（1），vbNullString）
'省略双管道||
N = InStr（1，FieldSpecs，||，vbBinaryCompare）
直到N = 0
FieldSpecs =替换（FieldSpecs，||，|）
N = InStr（1，FieldSpecs，||，vbBinaryCompare）
循环
'省略双逗号
N = InStr（1，FieldSpecs，,,，vbBinaryCompare）
Do Until N = 0
FieldSpecs = Replace（FieldSpecs，,,，，）
N = InStr（1，FieldSpecs，,,，vbBinaryCompare）
循环

'摆脱前导和尾随|字符，如果需要
如果StrComp（Left（FieldSpecs，1），|，vbBinaryCompare）= 0然后
FieldSpecs = Mid（FieldSpecs，2）
End If
If StrComp（Right（FieldSpecs，1），|，vbBinaryCompare）= 0然后
FieldSpecs = Left（FieldSpecs，Len（FieldSpecs） - 1）
End If

'读取文件
行输入#FNum，S
如果SkipLinesBeginningWith<> vbNullString和_
StrComp（Left（Trim（S），Len（SkipLinesBeginningWith）），_
SkipLinesBeginningWith，vbTextCompare）然后
如果Len（S）= 0然后
如果IgnoreBlankLines = False然后
设置R = R（2，1）
Else
'do nothing
End If
Else
'允许代码更改FieldSpecs值

如果FieldSpecs = vbNullString然后
'FieldSpecs为空。不做任何事情，不要导入。
Else
如果ImportThisLine（S）= True然后
FieldInfos = Split（FieldSpecs，|）
C = R.Column
对于FINdx = LBound（FieldInfos ）对于UBound（FieldInfos）
FInfo = Split（FieldInfos（FINdx），，）
R.EntireRow.Cells（1，C）.Value = Mid（S，CLng（FInfo（0）），CLng（FInfo（1）））
C = C + 1
下一个FINdx
RecCount = RecCount + 1
如果
设置R = R（2 ，1）
End If
End If
Else
'no skip first char
End If

循环直到EOF（FNum）

EndOfFunction：
如果Err.Number = 0然后
ImportFixedWidth = RecCount
Else
ImportFixedWidth = -1
End If
关闭#FNum
结束函数

私有函数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，产品，xyz）
对于N = LBound（NoImportWords）到UBound（NoImportWords）
T = NoImportWords（N）
L = Len（T）
如果StrComp左（S，L），T，vbTextCompare）= 0然后
ImportThisLine = False
退出函数
结束如果
下一个N
ImportThisLine = True
结束功能

解决方案

您的发布功能中有错误行说明

  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）

因为你不能有连续字符在一个字符串文字中，仍然将它视为一个连续字符，因为这样可以阻止你的代码编译，我认为这不是你实际代码中的那样。

Chip Pearson在他的功能上有一个错误。

 如果SkipLinesBeginningWith< ;> vbNullString And _ 
 StrComp（Left（Trim（S），Len（SkipLinesBeginningWith）），_ 
 SkipLinesBeginningWith，vbTextCompare）然后
   SkipLinesBeginningWith 变量为空字符串，则$ p $ 
 
 将排除所有行，因为
 
 
  
   SkipLinesBeginningWith<> vbNullString 将为 False 和
 
   StrComp（Left（Trim（S），Len（SkipLinesBeginningWith）），SkipLinesBeginningWith，vbTextCompare）部分将返回 0 ，相当于 False 。
 
 
 
 
 它实际上应该是
 如果SkipLinesBeginningWith = vbNullString或_ 
 StrComp（Left（Trim S），Len（SkipLinesBeginningWith）），_ 
 SkipLinesBeginningWith，vbTextCompare）然后
  
 
I am new to VBA and hoping for some help implementing a user-defined function. I would really appreciate any help!
Context: I am trying to import a batch of fixed-width text files into separate Excel workbooks. The text files all have the same fields and format. I know the length of each field. 
Issue: As I'm new to VBA, I looked for existing code. I found Chip Pearson's ImportFixedWidth function and have been trying to implement it per his description. First, I copied his example macro calling the ImportFixedWidth function and edited it to reflect the number and length of each of my data fields. I called that module 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
Then, I copied his ImportFixedWidth code into another module (Module2, see code block at the end of this post). 
I then tried to run the macro within the workbook, but it doesn't seem to work - that is, the function ImportFixedWidth should return either the number of records imported (if it works) or -1 (if it doesn't). When I run TestImport from the workbook, nothing is returned - the workbook remains blank.
Debugging: The code compiles, and I don't get any errors when I step through either the TestImport or Module2 code. 
Question: I'm at a loss for next steps in terms of debugging. Are there any obvious errors in my implementation, or how I am trying to run the macro? 
 Function ImportFixedWidth(FileName As String, _
    StartCell As Range, _
    IgnoreBlankLines As Boolean, _
    SkipLinesBeginningWith As String, _
    ByVal FieldSpecs As String) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ImportFixedWidth
' By Chip Pearson, [email protected] 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
 解决方案 
You have an error in your posted function at the lines saying
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")
because you can't have a continuation character within a String literal and still have it treated as a continuation character.  As that would stop your code compiling, I assume that isn't like that in your actual code.
Chip Pearson has an error in his function.  The lines saying
If SkipLinesBeginningWith <> vbNullString And _
   StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), _
     SkipLinesBeginningWith, vbTextCompare) Then
will exclude all lines from processing if the SkipLinesBeginningWith variable is a null string because
SkipLinesBeginningWith <> vbNullString will be False, and
the StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), SkipLinesBeginningWith, vbTextCompare) portion will return 0, which is equivalent to False.
It should actually be
If SkipLinesBeginningWith = vbNullString Or _
   StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), _
      SkipLinesBeginningWith, vbTextCompare) Then
                        
这篇关于尝试使用VBA将固定宽度的文本文件导入Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！