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