|
|
Our Hot Pick: Rising Antivirus 2006 - Certified by TUV & Checkmark! Get 10% discount by entering this coupon code: ONDISCOUNT10
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
|
|
Hi Luis,
I think this
[Quoted Text] > 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.
On 27 Sep 2006 17:45:07 -0700, "luis.a.roman[ at ]gmail.com"
<luis.a.roman[ at ]gmail.com> wrote:
>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
--
John Nurick [Microsoft Access MVP]
Please respond in the newgroup and not by email.
|
|
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
++++++++++++++++++++++++++++++++++++++++
John Nurick wrote:
[Quoted Text] > 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.
>
>
> On 27 Sep 2006 17:45:07 -0700, "luis.a.roman[ at ]gmail.com"
> <luis.a.roman[ at ]gmail.com> wrote:
>
> >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
>
> --
> John Nurick [Microsoft Access MVP]
>
> Please respond in the newgroup and not by email.
|
|
|