writeLine函数没有将数组写入文件 - excel vba

时间:2015-10-27 11:15:16

标签: excel vba excel-vba

我正在与前同事代码合作并遇到问题。我无法获得将数组写入创建的文本文件的函数(下面的代码)。

Function writeLine(DieID As String, writeArray() As String) As Boolean
Dim objFSO
Dim objTF
Dim objFSO2
Dim objTF2

Dim dataPos As Long
Dim argPos As Long

Dim foundID As String

Dim strTmp() As String
Dim resultStr As String
Dim data As Variant
Dim readString As String
Dim entry As Variant
Dim counter As Long
Dim completion As Boolean

On Error GoTo errorExit

dataPos = 0
argPos = 0
counter = 0
resultStr = ""
foundID = "2815"
completion = False
DieID = ufMAIN.ComboBox1.Value

Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.OpenTextFile(targetFilename)
Set objFSO2 = CreateObject("scripting.filesystemobject")
Set objTF2 = objFSO.CreateTextFile("temp.wfm")



'get the relevant line
Do Until objTF.AtEndOfStream
    readString = objTF.readline
    data = Split(readString, vbTab)
    foundID = data(5)
    If StrComp(foundID, DieID, 1) <> 0 Then
        objTF2.writeLine (readString)
    ElseIf StrComp(foundID, DieID, 1) = 0 Then
        'write initial value outside the loop
        strTmp = Split(readString, strDelim)
        'Modify the data array to include the data provided by writeArray
        For argPos = 6 To UBound(data)
            'check for index out of bounds, stop writing if it is!
            If (argPos - 6) > UBound(writeArray) Then Exit For 'need to check this will exit if the value is index out of bounds.
            data(argPos) = writeArray(dataPos)
            dataPos = dataPos + 1
        Next argPos
        'Take each entry from data and build a string delimited by strDelim
        Do Until counter > UBound(data)
            resultStr = IIf(counter <= UBound(data), resultStr & data(counter) & strDelim, resultStr & data(counter))
            counter = counter + 1
        Loop
        'output to temp file
        objTF2.writeLine (resultStr)
        completion = True
    End If
    'Check the Die ID was found, if not, throw an exception to alert the user
    If objTF.AtEndOfStream And completion = False Then _
            Err.Raise Number:=1003, Description:="The Die ID was invalid, please check and try again."
Loop
'Let temp file replace the original
objFSO.CopyFile "temp.wfm", targetFilename

objTF.Close
objTF2.Close
Kill ("temp.wfm")
Set objFSO = Nothing
Set objFSO2 = Nothing
writeLine = True
Exit Function


errorExit:
objTF.Close
objTF2.Close
Kill ("temp.wfm")
Set objFSO = Nothing
Set objFSO2 = Nothing
writeLine = Err

End Function

我是否正确地认为问题在于set objTF = objFSO.OpenTextFile(targetFilename)的声明,其中objTF应设置为启动宏的工作表?

任何帮助表示赞赏。 谢谢

******新增了代码 下面的代码进一步说明了我在做什么。它是代码块底部的第二个不起作用的函数。上一个函数运行正常 - 这让我对writeLine函数提出质疑......

Dim Rng
Dim Rngrow As Integer
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Data_Template")

Rng = ws.Columns(5).Find(DieID).Address 'finds the address of a matching entry in the workheet
Rngrow = Range(Rng).row 'extracts row number from address above

' creates an array of values from a row of cells
With ws

    Dim Arr(1 To 53) As String
    Dim i As Integer

    For i = 1 To 53

        Arr(i) = ws.Cells(Rngrow, 5).Offset(0, i)

    Next i

End With

End If

' Enters a value into the worksheet based on the values in the array
Functions_2.DieState DieID, Arr()

'writes line to an external file
Functions_2.writeLine DieID, Arr()

ufMAIN.ComboBox1.ListIndex = ufMAIN.ComboBox1.ListIndex + 1

 End Sub

0 个答案:

没有答案