VBA in ACCESS abending with run time error 1004

L

luis.a.roman

When I execute the code below on the second iteration reading the file
I get run-time error 1004.

Can someone help me correct this problem? I don't understand what I'm
missing.

Thank you - Luis

===============CODE ============================================
Option Compare Database
Public HoldRequirement As String
Public counter As Integer
Public activeCnt As Integer

Public parseproject As String

Sub ReadFileToProcess()
'Read the directory of the folder that contains the
'files to be loaded
activeCnt = 0
Dim fPathDirectory As String, fName As String
Dim fileLoaded1 As String, filesUploadedcnt As Integer
Dim tblProjectsAndRequirements As String, debugFlag As Boolean
debugFlag = True

'The Name of the table that the records are going to be stored
tblProjectsAndRequirements = "cpyProjectsAndRequirements"
filesUploadedcnt = 0
fPathDirectory = "F:\EVMSFiles\ITPlanningRequirements\"
fName = Dir(fPathDirectory, vbDirectory) ' Retrieve the first entry
DoCmd.Hourglass True
Do While fName <> "" ' Start the Loop
If fName <> "." And fName <> ".." Then
If Left(fName, 3) = "200" Then
If debugFlag = True Then
Debug.Print "Path Name= " & fPathDirectory & "File Name=" &
fName
filesUploadedcnt = filesUploadedcnt + 1
Dim xlsApp As Excel.Application
Dim xlswkb As Excel.Workbook
Set xlApp = New Excel.Application
'ActiveSheet.Cells.MergeCells = False
With xlApp
.Visible = True
Set xlWB =
..Workbooks.Open("F:\EVMSFiles\ITPlanningRequirements\" & fName, ,
False)
If activeCnt = 0 Then
activeCnt = activeCnt + 1
ActiveSheet.Cells.MergeCells = False
End If
End With
Call FormatRequirement

xlApp.Quit
Set xlsApp = Nothing
Set xlWB = Nothing
Set xlswkb = Nothing
Set xlsApp = Nothing
Set xlApp = Nothing
fileLoaded1 = fileLoaded1 & fName & " "
DoCmd.Hourglass False
Else
DoCmd.Hourglass True
DoCmd.Hourglass False
End If
End If
End If
fName = Dir
Loop
MsgBox "Files Loaded: " & filesUploadedcnt, , "JSF Projects and
Requirements"

End Sub
Sub FormatRequirement()
Range("A3").Select '---SECOND ITERATION ABEND - Run
time error 1004
counter = 0
HoldRequirement = Sheets(1).Range("a3").Value
Do Until counter > 550
Call fillRequirement
Loop
' Insert column for the Project
 
J

John Nurick

Hi Luis,

I think this
xlApp.Quit

may not actually be closing your first workbook, because you seem to be
modifying it without saving it.

Also, I'm surprised this works at all, because there doesn't seem to be
anything in the scope of this procedure that has a Range method.
Sub FormatRequirement()
Range("A3").Select

You'll do much better if you explicitly pass the object you want to work
on, e.g. (air code) and then work with Range objects rather than
Selection objects:

Sub FormatRequirement(W As Excel.Worksheet)
Dim raR As Excel.Range)
Set raR = W.Cells(3,1)
...
End Sub

and call it with something like

FormatRequirement xlWB.ActiveWorksheet

Finally, you should always declare
Option Explicit
at the beginning of every code module (check Require Variable
Declaration in Tools|Options). This will reveal some other errors in
your code.
 
L

luis.a.roman

Thank you John - Tried what you said but know I'm getting another error
I'm sure that is the explicit addressing and/or that I don't know
enough to correct the problem and you try to help me again. And if you
can refer me to articles to read and understand it that will be fine
too.

The code is below.

Luis
+++++++++++++++++++++++++++++++++++++++++
HoldRequirement = W.Range("a3").Value
Do Until counter > 550
fillRequirement(y as Excel.Worksheet) - Here is the problem.

Loop
' Insert column for the Project
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Range("A2").Select
ActiveCell.FormulaR1C1 = "Project"
Range("A3").Select
ActiveWindow.SmallScroll ToRight:=3
'Parse Project Number
parseproject = Range("B1").Value
starting = InStr(1, parseproject, "2")
parseproject = Mid(parseproject, starting, 11) & " "
counter = 0
Sheets(1).Range("A3").Select
counter = 0
Do Until counter > 550
Call fillProject
Loop
'select row one and delete it
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Call FormatHeading
End Sub

Sub fillRequirement(W As Excel.Worksheet) - ===> Related module
Dim rbR As Excel.Range
Set rbR = W.Cells(3, 1)
Debug.Print "Active Cell value=" & Sheets(1).ActiveCell.Offset(0, 0)
If ActiveCell.Offset.Value = "Firm Total:" Then
counter = counter + 550
Exit Sub
End If
++++++++++++++++++++++++++++++++++++++++
 
A

Abel

When I execute the code below on the second iteration reading the file
I get run-time error 1004.

Can someone help me correct this problem? I don't understand what I'm
missing.

Thank you - Luis

===============CODE ============================================
Option Compare Database
Public HoldRequirement As String
Public counter As Integer
Public activeCnt As Integer

Public parseproject As String

Sub ReadFileToProcess()
'Read the directory of the folder that contains the
'files to be loaded
activeCnt = 0
Dim fPathDirectory As String, fName As String
Dim fileLoaded1 As String, filesUploadedcnt As Integer
Dim tblProjectsAndRequirements As String, debugFlag As Boolean
debugFlag = True

'The Name of the table that the records are going to be stored
tblProjectsAndRequirements = "cpyProjectsAndRequirements"
filesUploadedcnt = 0
fPathDirectory = "F:\EVMSFiles\ITPlanningRequirements\"
fName = Dir(fPathDirectory, vbDirectory) ' Retrieve the first entry
DoCmd.Hourglass True
Do While fName <> "" ' Start the Loop
If fName <> "." And fName <> ".." Then
If Left(fName, 3) = "200" Then
If debugFlag = True Then
Debug.Print "Path Name= " & fPathDirectory & "File Name=" &
fName
filesUploadedcnt = filesUploadedcnt + 1
Dim xlsApp As Excel.Application
Dim xlswkb As Excel.Workbook
Set xlApp = New Excel.Application
'ActiveSheet.Cells.MergeCells = False
With xlApp
.Visible = True
Set xlWB =
.Workbooks.Open("F:\EVMSFiles\ITPlanningRequirements\" & fName, ,
False)
If activeCnt = 0 Then
activeCnt = activeCnt + 1
ActiveSheet.Cells.MergeCells = False
End If
End With
Call FormatRequirement

xlApp.Quit
Set xlsApp = Nothing
Set xlWB = Nothing
Set xlswkb = Nothing
Set xlsApp = Nothing
Set xlApp = Nothing
fileLoaded1 = fileLoaded1 & fName & " "
DoCmd.Hourglass False
Else
DoCmd.Hourglass True
DoCmd.Hourglass False
End If
End If
End If
fName = Dir
Loop
MsgBox "Files Loaded: " & filesUploadedcnt, , "JSF Projects and
Requirements"

End Sub
Sub FormatRequirement()
Range("A3").Select '---SECOND ITERATION ABEND - Run
time error 1004
counter = 0
HoldRequirement = Sheets(1).Range("a3").Value
Do Until counter > 550
Call fillRequirement
Loop
' Insert column for the Project
 
A

Abel

When I execute the code below on the second iteration reading the file
I get run-time error 1004.

Can someone help me correct this problem? I don't understand what I'm
missing.

Thank you - Luis

===============CODE ============================================
Option Compare Database
Public HoldRequirement As String
Public counter As Integer
Public activeCnt As Integer

Public parseproject As String

Sub ReadFileToProcess()
'Read the directory of the folder that contains the
'files to be loaded
activeCnt = 0
Dim fPathDirectory As String, fName As String
Dim fileLoaded1 As String, filesUploadedcnt As Integer
Dim tblProjectsAndRequirements As String, debugFlag As Boolean
debugFlag = True

'The Name of the table that the records are going to be stored
tblProjectsAndRequirements = "cpyProjectsAndRequirements"
filesUploadedcnt = 0
fPathDirectory = "F:\EVMSFiles\ITPlanningRequirements\"
fName = Dir(fPathDirectory, vbDirectory) ' Retrieve the first entry
DoCmd.Hourglass True
Do While fName <> "" ' Start the Loop
If fName <> "." And fName <> ".." Then
If Left(fName, 3) = "200" Then
If debugFlag = True Then
Debug.Print "Path Name= " & fPathDirectory & "File Name=" &
fName
filesUploadedcnt = filesUploadedcnt + 1
Dim xlsApp As Excel.Application
Dim xlswkb As Excel.Workbook
Set xlApp = New Excel.Application
'ActiveSheet.Cells.MergeCells = False
With xlApp
.Visible = True
Set xlWB =
.Workbooks.Open("F:\EVMSFiles\ITPlanningRequirements\" & fName, ,
False)
If activeCnt = 0 Then
activeCnt = activeCnt + 1
ActiveSheet.Cells.MergeCells = False
End If
End With
Call FormatRequirement

xlApp.Quit
Set xlsApp = Nothing
Set xlWB = Nothing
Set xlswkb = Nothing
Set xlsApp = Nothing
Set xlApp = Nothing
fileLoaded1 = fileLoaded1 & fName & " "
DoCmd.Hourglass False
Else
DoCmd.Hourglass True
DoCmd.Hourglass False
End If
End If
End If
fName = Dir
Loop
MsgBox "Files Loaded: " & filesUploadedcnt, , "JSF Projects and
Requirements"

End Sub
Sub FormatRequirement()
Range("A3").Select '---SECOND ITERATION ABEND - Run
time error 1004
counter = 0
HoldRequirement = Sheets(1).Range("a3").Value
Do Until counter > 550
Call fillRequirement
Loop
' Insert column for the Project
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top