| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| How to convert all 3d references to normal references in a workboo | Excel Discussion (Misc queries) | |||
| How to convert all 3d references to normal references in a workboo | Excel Worksheet Functions | |||
| Help with converting a block of cells with Absolute and mixed references to relative references | Excel Worksheet Functions | |||
| How to rename references from range names to cell references | Excel Discussion (Misc queries) | |||
| Tools | References - information about references | Excel Programming | |||
Linear Mode
