|
VBA References
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 |
VBA References
What is the error?
"Kevin" wrote: 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 |
VBA References
Thanks for the quick response. The program returns "Error Number: 62"
-Kevin "JLGWhiz" wrote: What is the error? "Kevin" wrote: 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 |
VBA References
try changing
Do Until WriteRowNum = LastRow + 1 to Do Until WriteRowNum = LastRow + 1 or eof(filenum) You error indicates that you are trying to read past the end of file. -- Regards, Tom Ogilvy "Kevin" wrote: Thanks for the quick response. The program returns "Error Number: 62" -Kevin "JLGWhiz" wrote: What is the error? "Kevin" wrote: 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 |
VBA References
Thanks Tom. I'll try this. I'm sure it will resolve the problem.
-Kevin "Tom Ogilvy" wrote: try changing Do Until WriteRowNum = LastRow + 1 to Do Until WriteRowNum = LastRow + 1 or eof(filenum) You error indicates that you are trying to read past the end of file. -- Regards, Tom Ogilvy "Kevin" wrote: Thanks for the quick response. The program returns "Error Number: 62" -Kevin "JLGWhiz" wrote: What is the error? "Kevin" wrote: 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 |
| All times are GMT +1. The time now is 03:38 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com