K
Kevin
I got a PC upgrade at work. And some Excel VBA code that used to work just
fine now returns an error. The code looks like this.
=================
Dim WriteRowNum As Long
Dim counter As Long
Sub GetFileContents()
Dim myCell As Range, strDate As String, NewSheet As Object
Application.ScreenUpdating = False
Application.EnableEvents = False
Set NewSheet = Worksheets.Add
NewSheet.Name = "data"
strDate = InputBox("Enter date (mm-dd-yyyy).")
strFilename = "THIS".txt"
strSubFolder = "THAT\"
strSourceFolder = "THE_OTHER\"
strPathAndFilename = strSourceFolder & strSubFolder & strFilename
WriteRowNum = 1
counter = 0
ListFileContents (strPathAndFilename)
ActiveWorkbook.Saved = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub ListFileContents(strWorkingfile)
On Error GoTo ErrorCheck
Dim ResultStr As String
Dim FileNum As Integer
Dim WorkResult As String
Dim strTest As String
Dim LastRow As Long
Dim LastRecordNumber As Long, FirstRecordNumber As Long
FirstRecordNumber = InputBox("Enter First Record Number")
LastRecordNumber = InputBox("Enter Last Record Number")
LastRow = LastRecordNumber - FirstRecordNumber + 1
Application.ScreenUpdating = False
Application.EnableEvents = False
FileNum = FreeFile()
Open strWorkingfile For Input As #FileNum
Application.ScreenUpdating = False
Do Until WriteRowNum = LastRow + 1
Line Input #FileNum, ResultStr
counter = counter + 1
WorkResult = ResultStr
strTest = Mid$(WorkResult, 1, 5)
If WriteRowNum <> LastRow + 1 Then
If counter > FirstRecordNumber - 1 Then
Worksheets("data").Cells(WriteRowNum, 1) = WorkResult
Worksheets("data").Cells(WriteRowNum, 2) = counter
Worksheets("data").Cells(WriteRowNum, 3) = WriteRowNum
WriteRowNum = WriteRowNum + 1
End If
Else
GoTo EndThis
End If
Loop
Close
Exit Sub
ErrorCheck:
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "An error occured in the code."
EndThis:
End Sub
=================
Any thoughts would be greatly appreciated.
Thanks.
Kevin
fine now returns an error. The code looks like this.
=================
Dim WriteRowNum As Long
Dim counter As Long
Sub GetFileContents()
Dim myCell As Range, strDate As String, NewSheet As Object
Application.ScreenUpdating = False
Application.EnableEvents = False
Set NewSheet = Worksheets.Add
NewSheet.Name = "data"
strDate = InputBox("Enter date (mm-dd-yyyy).")
strFilename = "THIS".txt"
strSubFolder = "THAT\"
strSourceFolder = "THE_OTHER\"
strPathAndFilename = strSourceFolder & strSubFolder & strFilename
WriteRowNum = 1
counter = 0
ListFileContents (strPathAndFilename)
ActiveWorkbook.Saved = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub ListFileContents(strWorkingfile)
On Error GoTo ErrorCheck
Dim ResultStr As String
Dim FileNum As Integer
Dim WorkResult As String
Dim strTest As String
Dim LastRow As Long
Dim LastRecordNumber As Long, FirstRecordNumber As Long
FirstRecordNumber = InputBox("Enter First Record Number")
LastRecordNumber = InputBox("Enter Last Record Number")
LastRow = LastRecordNumber - FirstRecordNumber + 1
Application.ScreenUpdating = False
Application.EnableEvents = False
FileNum = FreeFile()
Open strWorkingfile For Input As #FileNum
Application.ScreenUpdating = False
Do Until WriteRowNum = LastRow + 1
Line Input #FileNum, ResultStr
counter = counter + 1
WorkResult = ResultStr
strTest = Mid$(WorkResult, 1, 5)
If WriteRowNum <> LastRow + 1 Then
If counter > FirstRecordNumber - 1 Then
Worksheets("data").Cells(WriteRowNum, 1) = WorkResult
Worksheets("data").Cells(WriteRowNum, 2) = counter
Worksheets("data").Cells(WriteRowNum, 3) = WriteRowNum
WriteRowNum = WriteRowNum + 1
End If
Else
GoTo EndThis
End If
Loop
Close
Exit Sub
ErrorCheck:
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox "An error occured in the code."
EndThis:
End Sub
=================
Any thoughts would be greatly appreciated.
Thanks.
Kevin