Error in Vba code for Multi excel files

R

rajivdekris

New Member
Joined
Aug 7, 2011
Messages
5
Hi

I have this error happening for last one day. Its been working for 4 years.

Error happens when its reach line

Workbooks.Open (strFolderA & ak.Worksheets("File List").Range("A" & vRow))


What is the process its doing ?

1) Multiple forms of excel file in ENIR update folder
2) Copying targeted data from these excel forms and transferring to data summary file
3) First its copy all the name of excel forms from ENIR folder and tag it in hidden tab of data summary file called “File List”
4) Pulls all data and highlight with yellow on newly updated rows in data summary
5) Transfer all the excel forms to new completed folder

As I said its been working all along until yesterday. Do not what the issues

Error 1) data link properties – data source G:\Purchasing\Shared\Reports\NEW-ITEM\ENIR-UPDATE\
2) Please enter MA database engine OLE DB initialization information ( next window) - ok
3) Run time error 1004 Method open of object workbooks failed
4) Debug target to - Workbooks.Open (strFolderA & ak.Worksheets("File List").Range("A" & vRow))


Here is the original code.

Hi

I have this error happening for last one day. Its been working for 4 years.

Error happens when its reach line

Workbooks.Open (strFolderA & ak.Worksheets("File List").Range("A" & vRow))


What is the process its doing ?

1) Multiple forms of excel file in ENIR update folder
2) Copying targeted data from these excel forms and transferring to data summary file
3) First its copy all the list of files from ENIR folder and tag it in hidden tab of data summary file called “File List”
4) Pulls all data and highlight with yellow on newly updated rows in data summary
5) Transfer all the excel forms to new completed folder

As I said its been working all along until yesterday. Do not what the issues

Error 1) data link properties – data source G:\Purchasing\Shared\Reports\NEW-ITEM\ENIR-UPDATE\
2) Please enter MA database engine OLE DB initialization information ( next window) - ok
3) Run time error 1004 Method open of object workbooks failed
4) Debug target to - Workbooks.Open (strFolderA & ak.Worksheets("File List").Range("A" & vRow))


Here is the original code.

Sub Update()
Dim lRow As Long
Dim mRow As Long
Dim vRow
Dim wRow
Dim bk As Workbook
Dim ak As Workbook
Dim Existing As String
Dim ReqNo As Long
Dim strFolderA As String
Dim strFolderB As String
Dim strFile As String
Dim strfullname As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'strFolderA = "C:\Documents and Settings\r3u1700\My Documents\Raj\New Item Request\Reports\"
'strFolderB = "C:\Documents and Settings\r3u1700\My Documents\Raj\New Item Request\Reports\Completed\"

strFolderA = "G:\Purchasing\Shared\Reports\NEW-ITEM\ENIR-UPDATE\"
strFolderB = "G:\Purchasing\Shared\Reports\NEW-ITEM\ENIR-UPDATE\Update-Completed\"


Set ak = ActiveWorkbook

lRow = ak.Worksheets("File List").Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Row
mRow = ak.Worksheets("Summary").Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Row

Range("A3:A" & mRow).Interior.ColorIndex = None

For vRow = 2 To lRow

Existing = "0"
Workbooks.Open (strFolderA & ak.Worksheets("File List").Range("A" & vRow))
'Workbooks.Open ("G:\Purchasing\Shared\Reports\NEW-ITEM\ENIR-UPDATE\" & ak.Worksheets("File List").Range("A" & vRow))
Set bk = ActiveWorkbook
strFile = bk.Name
If bk.ActiveSheet.Range("I3") = "NEW ITEM REQUEST FORM" Then
ReqNo = bk.ActiveSheet.Range("H7").Value

mRow = ak.Worksheets("Summary").Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Row

For wRow = 2 To mRow
If ak.Worksheets("Summary").Range("A" & wRow) = ReqNo Then
'Updated Req
ak.Sheets("Summary").Range("A" & wRow).Interior.ColorIndex = 6
'TM Send Date
ak.Worksheets("Summary").Range("AA" & wRow) = bk.ActiveSheet.Range("A36")
'RSM Approved Date
If bk.ActiveSheet.Range("AO49") <> "" Then
ak.Worksheets("Summary").Range("AB" & wRow) = bk.ActiveSheet.Range("AO49")
End If
'CAT MAN Approval Date
If bk.ActiveSheet.Range("AO51") <> "" Then
ak.Worksheets("Summary").Range("AC" & wRow) = bk.ActiveSheet.Range("AO51")
End If
'Buyer ID
If bk.ActiveSheet.Range("S54") <> "" Then
ak.Worksheets("Summary").Range("AD" & wRow) = bk.ActiveSheet.Range("S54")
ak.Worksheets("Summary").Range("AE" & wRow) = bk.ActiveSheet.Range("W54")
ak.Worksheets("Summary").Range("AF" & wRow) = bk.ActiveSheet.Range("AB54")
ak.Worksheets("Summary").Range("AG" & wRow) = bk.ActiveSheet.Range("AF54")
ak.Worksheets("Summary").Range("AH" & wRow) = bk.Sheets("Form").Range("E39")
ak.Worksheets("Summary").Range("AI" & wRow) = bk.Sheets("Form").Range("P39")
End If
Existing = "1"
End If
Next wRow

If Existing = "0" Then

mRow = ak.Worksheets("Summary").Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'Req Number
ak.Sheets("Summary").Range("A" & mRow) = bk.Sheets("Form").Range("H7")
ak.Sheets("Summary").Range("A" & mRow).Interior.ColorIndex = 6
'Sales ID
ak.Sheets("Summary").Range("B" & mRow) = bk.Sheets("Form").Range("A11")

'TM Name
ak.Sheets("Summary").Range("C" & mRow) = bk.Sheets("Form").Range("D11")

'TM Email Address
ak.Sheets("Summary").Range("D" & mRow) = bk.Sheets("Form").Range("N11")

'DSM Name
ak.Sheets("Summary").Range("E" & mRow) = bk.Sheets("Form").Range("X11")

'GP %
ak.Sheets("Summary").Range("F" & mRow) = bk.Sheets("Form").Range("AE11")

'Potential Monthly Sales
ak.Sheets("Summary").Range("G" & mRow) = bk.Sheets("Form").Range("AO11")

'Customer #
ak.Sheets("Summary").Range("H" & mRow) = bk.Sheets("Form").Range("A13")

'Customer Request Date
ak.Sheets("Summary").Range("I" & mRow) = bk.Sheets("Form").Range("I13")

'Customer Date Needed
ak.Sheets("Summary").Range("J" & mRow) = bk.Sheets("Form").Range("O13")

'Account Type
ak.Sheets("Summary").Range("K" & mRow) = bk.Sheets("Form").Range("U13")

'Customer Name
ak.Sheets("Summary").Range("L" & mRow) = bk.Sheets("Form").Range("Z13")

'DSM Email
ak.Sheets("Summary").Range("M" & mRow) = bk.Sheets("Form").Range("Z14")

'Proprietary
If bk.Sheets("Form").Range("W20").Value = True Then
ak.Sheets("Summary").Range("N" & mRow).Value = "Y"
End If

If bk.Sheets("Form").Range("AA20").Value = True Then
ak.Sheets("Summary").Range("N" & mRow).Value = "N"
End If

If bk.Sheets("Form").Range("AD20").Value = True Then
ak.Sheets("Summary").Range("N" & mRow).Value = "N/A"
End If

'National Contract
If bk.Sheets("Form").Range("AO22").Value = True Then
ak.Sheets("Summary").Range("O" & mRow).Value = "Y"
End If

If bk.Sheets("Form").Range("AQ22").Value = True Then
ak.Sheets("Summary").Range("O" & mRow).Value = "N"
End If

'Comments TM
ak.Sheets("Summary").Range("P" & mRow) = bk.Sheets("Form").Range("J24")

'Asys Code
ak.Sheets("Summary").Range("Q" & mRow) = bk.Sheets("Form").Range("A29")

'Label
ak.Sheets("Summary").Range("R" & mRow) = bk.Sheets("Form").Range("F29")

'Pack Size
ak.Sheets("Summary").Range("S" & mRow) = bk.Sheets("Form").Range("L29")

'Desciption
ak.Sheets("Summary").Range("T" & mRow) = bk.Sheets("Form").Range("R29")

'MFG #
ak.Sheets("Summary").Range("U" & mRow) = bk.Sheets("Form").Range("A31")

'Vendor
ak.Sheets("Summary").Range("V" & mRow) = bk.Sheets("Form").Range("I31")

'Weekly Demand
ak.Sheets("Summary").Range("W" & mRow) = bk.Sheets("Form").Range("AC31")

'Cost
ak.Sheets("Summary").Range("X" & mRow) = bk.Sheets("Form").Range("AH31")

'Sell Price
ak.Sheets("Summary").Range("Y" & mRow) = bk.Sheets("Form").Range("AN31")

'Product Type
If bk.Sheets("Form").Range("H33").Value = True Then
ak.Sheets("Summary").Range("Z" & mRow).Value = "Refrigerated"
End If

If bk.Sheets("Form").Range("O33").Value = True Then
ak.Sheets("Summary").Range("Z" & mRow).Value = "Frozen"
End If

If bk.Sheets("Form").Range("T33").Value = True Then
ak.Sheets("Summary").Range("Z" & mRow).Value = "Dry"
End If

If bk.Sheets("Form").Range("X33").Value = True Then
ak.Sheets("Summary").Range("Z" & mRow).Value = "Non Food"
End If

If bk.Sheets("Form").Range("AD33").Value = True Then
ak.Sheets("Summary").Range("Z" & mRow).Value = "Equipment and Supply"
End If

'TM Send Date
ak.Worksheets("Summary").Range("AA" & wRow) = bk.ActiveSheet.Range("A36")
'RSM Approved Date
If bk.ActiveSheet.Range("AO49") <> "" Then
ak.Worksheets("Summary").Range("AB" & wRow) = bk.ActiveSheet.Range("AO49")
End If
'CAT MAN Approval Date
If bk.ActiveSheet.Range("AO51") <> "" Then
ak.Worksheets("Summary").Range("AC" & wRow) = bk.ActiveSheet.Range("AO51")
End If
'Buyer ID
If bk.ActiveSheet.Range("S54") <> "" Then
ak.Worksheets("Summary").Range("AD" & wRow) = bk.ActiveSheet.Range("S54")
ak.Worksheets("Summary").Range("AE" & wRow) = bk.ActiveSheet.Range("W54")
ak.Worksheets("Summary").Range("AF" & wRow) = bk.ActiveSheet.Range("AB54")
ak.Worksheets("Summary").Range("AG" & wRow) = bk.ActiveSheet.Range("AF54")
ak.Worksheets("Summary").Range("AH" & wRow) = bk.Sheets("Form").Range("E39")
ak.Worksheets("Summary").Range("AI" & wRow) = bk.Sheets("Form").Range("P39")
End If
End If

bk.Close False

strfullname = strFolderB & strFile
If FileExists(strfullname) Then
Kill strfullname
End If

On Error Resume Next
Name strFolderA & strFile As strFolderB & strFile
Else
bk.Close False

strfullname = strFolderB & strFile
If FileExists(strfullname) Then
Kill strfullname
End If

Name strFolderA & strFile As strFolderB & strFile
End If
Next vRow

lRow = ak.Worksheets("Summary").Cells(Rows.Count, 1) _
.End(xlUp).Offset(0, 0).Row

Workbooks.Open ("G:\Purchasing\Shared\Reports\Everything-Report\EVR.xls")
Set bk = ActiveWorkbook
On Error Resume Next
For vRow = 3 To lRow
If ak.Worksheets("Summary").Range("Q" & vRow) <> "" And ak.Worksheets("Summary").Range("AJ" & vRow) = "" Then
ak.Worksheets("Summary").Range("AJ" & vRow) = Application.WorksheetFunction.VLookup(ak.Worksheets("Summary").Range("Q" & vRow).Value, bk.ActiveSheet.Columns("A:AC"), 29, False)
End If
Next vRow
bk.Close False

ak.Save
'ak.SaveAs (strFolderB & ak.Name)
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Please help
 
Last edited:

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
The processor is probably looking at the range reference as a range instead of a value. Try adding the word Value as shown in red.
Code: 
Workbooks.Open (strFolderA & ak.Worksheets("File List").Range("A" & vRow).[COLOR="#800000"]Value[/COLOR])
 'Workbooks.Open ("G:\Purchasing\Shared\Reports\NEW-ITEM\ENIR-UPDATE\" & ak.Worksheets("File List").Range("A" & vRow).[COLOR="#B22222"]Value[/COLOR])
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Modify VBA script to count rows with data in multiple sheets
Replies
0
Views
400
irishjsk
I
V
  • Question Question
VBA excel worksheet2 out of range even though the cell is within the range and additional value created
Replies
4
Views
213
MARK858
MARK858
J
  • Question Question
Assistance changing VBA code to display as HTML or picture of a selection in Lotus Notes
Replies
2
Views
199
jularobert
J
S
  • Question Question
Conditional Formatting changes from XLSM to XLSX when I use VBA code to save a new file
Replies
1
Views
467
JerrExcel
JerrExcel
M
  • Solved
modifying code to get last value based on sheet name from file to another
Replies
7
Views
344
mumps
mumps

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top