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

时间:2017-07-19 18:50:39

标签: excel vba excel-vba text

我是VBA的新手,希望能够帮助实现用户定义的功能。我真的很感激任何帮助!

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

问题:由于我是VBA新手,我查找了现有代码。我发现Chip Pearson's ImportFixedWidth function并且一直试图按照他的描述来实现它。首先,我复制了他的示例宏,调用了 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,请参阅本文末尾的代码块)。

然后我尝试在工作簿中运行宏,但它似乎不起作用 - 也就是说,函数ImportFixedWidth应该返回导入的记录数(如果它可以工作)或-1(如果它没有按' T)。当我从工作簿运行TestImport时,返回 nothing - 工作簿仍为空白。

调试:代码编译,当我单步执行 TestImport 或Module2代码时,我不会收到任何错误。

问题:我在调试方面遇到了下一步的困难。我的实现中是否有任何明显的错误,或者我是如何尝试运行宏的?

 Function ImportFixedWidth(FileName As String, _
    StartCell As Range, _
    IgnoreBlankLines As Boolean, _
    SkipLinesBeginningWith As String, _
    ByVal FieldSpecs As String) As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ImportFixedWidth
' By Chip Pearson, chip@cpearson.com 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

1 个答案:

答案 0 :(得分:3)

您在发布的功能中出现错误

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的功能有误。这句话说

If SkipLinesBeginningWith <> vbNullString And _
   StrComp(Left(Trim(S), Len(SkipLinesBeginningWith)), _
     SkipLinesBeginningWith, vbTextCompare) Then
如果SkipLinesBeginningWith变量为空字符串,则

将排除处理所有行,因为

  • 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
相关问题