Free Microsoft Excel 2013 Quick Reference

error 1004 excel vba workbooks.open

Hi all.
Before I decided to write this post, I had a look trying to google my stupid error, but I couldn't find anything that looks exactly like my issue.

	VB:
	
Workbooks.Open Filename:="c:filesclients.xlsx" 
Workbooks("clients.xlsx").Worksheets(1).Range("a1" & ":x500").Copy _ 
Workbooks("cash").Worksheets(2).Range("A1") 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
The thing is that on my computer at work (windows 7 enterprise with office 2007 professional) the code runs without any problem.
And when I opened the same file on my laptop (same SO, same office) appear the following error: Run-time error '1004' Method 'Open' of object 'Workbooks' failed.
Please! Help!

Thank you in advance.
Gabi

P.S. By the way. Very nice job with this site, guys!


Post your answer or comment

comments powered by Disqus
I have what I thought was a fairly simple macro. This macro runs fine if I step thru it in debug but gives me an error 1004 if I launch it from a button from the sheet. Does anybody have any ideas? (I'm running Excel 2003 sp1 on windows XP pro 2002 sp1)

Sub PublishToIntranet()
'
'
'
On Error GoTo Err_Handler_Publish_To_Intranet
Range("A1:Q61").Select
Selection.Copy
ChDir "lrfp3psmintranetDocumentsdryerdailyPlan"
workbooks.Open Filename:= _
"lrfp3psmIntranetDocumentsDryerDailyPlanDailyPlan.xls"
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close
MsgBox "Page published to Intranet."
Exit Sub
Err_Handler_Publish_To_Intranet:
MsgBox "Unexpected error " & Err.Number & " " & Err.Description & ". Page not published. Please contact CIS", vbOKOnly
End Sub

I have a safe data source, where large files are always stored in a .gz

Is there a way to get excel VBA to open up the .gz file?

In the old old days, there used to be a windows command line that would extract files from a windows zip file, but I can't seem to find that anywhere. There has got to be an automated way to do this....

Thanks very much in advance.

Joey

Hi

i am using a program called WinWedge which is used to transfer readings/measurements/data from a digital readout to Excel

just wondering if Excel VBA can open this problem when a Excel file is opened?

many thanks in advance

Workbooks.Open with CorruptLoad parameter set to xlRepairFile fails on Excel
5.0/95 file due to Chart, with Error 1004 Method 'Open' of object
'Workbooks' failed.

We have a sample Excel 5.0 (Excel 95) file that is being opened through a
Visual Basic 6.0 function on Excel 2003 COM call. The Workbooks.Open method
succeededs if CorruptLoad is set to xlNormalLoad, but it fails with Error
1004 if Corrupt Load is set to xlRepairFile.

The Excel 5.0 document has a single sheet with a Chart on it. If the file
is modified such that only the chart is removed, the Open with xlRepairFile
works. If everything else is removed from the file and the Chart remains,
the xlRepairFile Open still fails.

Any ideas on why this might be failing? Is there a limitation of Excel 2003
opening Excel 5.0 file with Charts?
Thanks for any input on this topic.

Function WorkbooksFailSafeOpen(oWorkbooks As Workbooks, strLocalInputFile As
String) As Workbook

Dim lngErrNumber As Long
Dim strErrorDescription As String

On Error Resume Next

Set WorkbooksFailSafeOpen = oWorkbooks.Open(strLocalInputFile, _
UpdateLinks:=2, _
ReadOnly:=True, _
Password:="", _
IgnoreReadOnlyRecommended:=True, _
CorruptLoad:=xlRepairFile)

lngErrNumber = Err.Number

On Error GoTo 0

' If the first open failed with Error 1004
' Method 'Open' of object Workbooks' failed
' Try the alternate Open, without xlRepairFile setting

' Note we can't seem to get the description
' "Method 'Open' of object 'Workbooks' failed"
' out of the Err.Description variable, comes out as
' "Application-defined or object-defined error"
' even though pop-up dialog displays Method 'Open'... message
' so just check against generic error number 1004

If lngErrNumber = 1004 Then
Set WorkbooksFailSafeOpen = oWorkbooks.Open(strLocalInputFile, _
UpdateLinks:=2, _
ReadOnly:=True, _
Password:="", _
IgnoreReadOnlyRecommended:=True, _
CorruptLoad:=xlNormalLoad)
End If

End Function

Hi,

In an Excel 2000 programm I had the VBA code:

Dim myWB As Workbook
Dim myXMLpage As String
.........
myXMLpage = "Here is the address of an external URL of a xml page"
Set myWB = Workbooks.Open(myXMLpage)

The value of myXMLpage looks like "http://www.xyz.com/502?tpl.xml".
Because of internal reasons I have to "hide" the corrrect address
standing behind "xyz.com" but the rest of the url is the same I use.

In Excel 2000 everything worked fine without any problems.

Since I moved to Excel 2003 VBA ends in a run time error while
executing the "Set myWB" command. I see that the open runs and thatb
the code tries to open but immediately later I get the run time error
with error numer 1004 and description "Method 'Open' of object
'Workbooks' failed." No other workbook is open in my Excel application
after the break.

Has anyone an idea how I get my programm running in Excel 2003 again?

Thanks in advance.
Winfried

Hi Guys,

I am trying to update specific fields of table in Ms Access, through Excel VBA. My select and add new record queries work, but the update query always throws the RUN TIME ERROR 80040e10 - "No Value Given To One or More Required Parameters"

I have checked my table name and the other field names over and over again, but I see nothing wrong with the quesry. I am trying to update a few fields from the database, for a existing record number (autonumber).


	VB:
	
 
Function CheckDB(Serial_No_New_Part As String, Serial_No_Failed_Part As String, ConStr As String) _ 
    As Boolean 
    Dim MsgBox_Answer As Integer 
     
     ' Variable stores ADO Connection Object to Ms Access DB
    Dim cnt As New ADODB.Connection 
     
     ' Variable for Recordset Object
    Dim rst As New ADODB.Recordset 
     
     ' Variable stores Database path
    Dim strDB As String 
     
     
     ' Variable stores SQL 'SELECT' Query
    Dim SQLSelectNewPart As String 
    Dim SQLSelectFailedPart As String 
    Dim SQLUpdate As String 
     
    Dim Primary_No_Failed_Part As Long 
    Dim Run_Time_Hrs_Failed_Part As Long 
    Dim Part_Status_Failed_part As String 
    Dim Date_Failed_Failed_part As Date 
    Dim Failed_Location_Failed_Part As String 
    Dim Failure_History_Failed_Part As String 
    Dim Description_Failed_Part As String 
     
     ' Set the string to the path of your database
    strDB = ConStr 
     
     ' Open connection to the database
    cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
    "Data Source=" & strDB & ";" 
     
    rst.Open SQLSelectNewPart, cnt, adOpenDynamic, adLockBatchOptimistic, adCmdText 
     
     
     ' In simple words, look whether any records in the DB contain the same "Part_Serial_No"
     ' Check whether recordset is empty,implies no records found
     ' BOF = Begining of File
     ' EOF = End of File
     ' IF ((Not BOF = TRUE) AND (Not EOF = TRUE)), Implies Records Have Been Found
    If (rst.BOF = False And rst.EOF = False) Then 
         'Primary_Key = rst.Fields("Primary_No").Value
         
        MsgBox_Answer = MsgBox("A part with the matching 'Serial No' already exists in the Database" _ 
        & vbCrLf & "Click on the 'OK BUTTON' to display the 'ADD REPAIRED PART FORM'" & vbCrLf & _ 
        "or click on the 'CANCEL BUTTON' to edit the 'ADD NEW/REPLACE OLD FORM'", vbOKCancel, _ 
        "Existing Part in Database") 
         
        If (MsgBox_Answer = 1) Then 
             
             'Temporary Storage - Retrieve Existing Failed Tage Info from Database
             'Store this info temporarily on Sheet7 - Row(2-3), Column 5
            Sheet7.Cells(2, 5).Value = CLng(rst.Fields("Primary_No").Value) 
             'Failed Part Row No on Sheet1 retrieved from UserForm6
            Sheet7.Cells(3, 5).Value = CLng(UserForm6.TextBox17.Value) 
             'Write DB Path
            Sheet7.Cells(4, 5).Value = UCase(CStr(strDB)) 
             
             
             'Close Connection Objects and Recordset Objects.
             ' Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
             
             
            CheckDB = False 
             
            Unload UserForm6 
            UserForm1.Show 
             
        ElseIf (MsgBox_Answer = 2) Then 
            CheckDB = False 
             
             'Close Connection Objects and Recordset Objects.
             'Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
            Exit Function 
        Else 
            CheckDB = False 
             
             'CloseConnection Objects and Recordset Objects.
             'Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
            Exit Function 
        End If 
         
         'Else no records have been found - Implies New Part is New and is not a Failed part that has been repaired
         'Check whether Failed Part exists in DB
         'If Failed Part Exists, Append existing record
         'Else Add New Record for Failed Part in DB
    Else 
        rst.Close 
         'Now check whether Failed Part exists in DB
        SQLSelectFailedPart = "Select * FROM Failed Where Serial_No= '" _ 
        & UCase(CStr(Serial_No_Failed_Part)) & "'" 
         
         'Open recordset based on Trial table
        rst.Open SQLSelectFailedPart, cnt, adOpenDynamic, adLockBatchOptimistic, adCmdText 
         
        If (rst.BOF = True And rst.EOF = True) Then 
             
             'Add Failed Part Data as a new Record
             'Close Open Recordset
            rst.Close 
             
             '*********START Procedure to Add New Record********
            rst.Open "Failed", cnt, adOpenKeyset, adLockOptimistic, adCmdTable 
            rst.AddNew 
            rst!Part = UCase(CStr(UserForm6.TextBox14.Value)) 
            rst!Serial_No = UCase(CStr(UserForm6.ComboBox3.Value)) 
            rst!Material_Type = UCase(CStr(UserForm6.TextBox9.Value)) 
            rst!Run_Time_Hours = CLng(UserForm6.TextBox10.Value) 
            rst!Current_Part_Status = UCase(CStr(UserForm6.ComboBox4.Value)) 
            rst!Date_Failed = Format(CDate(UserForm6.TextBox12.Value), "mm/dd/yyyy") 
            rst!Failed_Location = UCase(CStr(UserForm6.TextBox15.Value)) 
            rst!Vendor_Name = UCase(CStr(UserForm6.TextBox13.Value)) 
             
            rst!Description = Replace(UCase(CStr(UserForm6.TextBox19.Value)), Chr(34), "''") 
            rst.Update 
             
            CheckDB = True 
             
             'close Connection Objects and Recordset Objects.
             'Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
             
             
             'If existing record found, then Append and Update existing record
        Else 
            Primary_No_Failed_Part = rst.Fields("Primary_No").Value 
             
            Decription_Failed_Part = Replace(UCase(CStr(rst.Fields("Description").Value)), _ 
            Chr(34), "'") 
             
            Part_Status_Failed_part = UCase(CStr("Failed")) 
             
            Run_Time_Hrs_Failed_Part = CLng(rst.Fields("Run_Time_Hours")) 
             
            Date_Failed_Failed_part = Format(rst.Fields("Date_Failed"), "mm/dd/yyyy") 
             
            Failed_Location_Failed_Part = UCase(CStr(rst.Fields("Failed_Location"))) 
             
             'Close open RecordSet
            rst.Close 
             
            Failure_History_Failed_Part = UCase(CStr("Run Time Hours = " & Run_Time_Hrs_Failed_Part & _ 
            vbCrLf & "Date_Failed = " & Format(CDate(Date_Failed_Failed_part), "dd,mmm,yyyy") & _ 
            vbCrLf & "Failure_Location = " & Failed_Location_Failed_Part & vbCrLf & _ 
            "---------------------------------------" & vbCrLf)) 
             
            Description_Failed_Part = UCase(CStr(vbCrLf & "-----------------------------------" & vbCrLf & _ 
            UCase(CStr(UserForm6.TextBox19.Value)))) 
             
            Description_Failed_Part = Replace(Description_Failed_Part, Chr(34), "''") 
             
             
             'SQL UPDATE QUERY
            SQLUpdate = "UPDATE Failed SET [Run_Time_Hours] = " & CLng(UserForm6.TextBox10.Value) & _ 
            ", [Current_Part_Status] = '" & UCase(CStr(Part_Status_Failed_part)) & _ 
            "', [Date_Failed] = " & CDate(UserForm6.TextBox12.Value) _ 
            & ", [Failed_Location] = '" & UCase(CStr(UserForm6.TextBox15.Value)) & _ 
            "', [Failure_History] = '" & Failure_History_Failed_Part & _ 
            "', [Description] = '" & Description_Failed_Part & _ 
            "' WHERE Failure.Primary_No = " & CLng(Primary_No_Failed_Part) 
             
             
             'ERROR on this statement
            rst.Open SQLUpdate, cnt 
             
             
            CheckDB = True 
             
             'close Connection Objects and Recordset Objects.
             'Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
             
            Unload UserForm6 
        End If 
         
    End If 
End Function 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
--------------------------------------------------------------------------

Could someone point our what I am doing wrong. The error occurs on the statement

	VB:
	
rst.Open SQLUpdate, cnt 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
,
RUN TIME ERROR: 80040e10 - "No Value Given To One or More Required Parameters"

Thanks.

Regards,

Cnerurkar

Deleted and re-written for clarity:

In Excel 2004, workbooks.open("http://www.mywebsite.com/test.xls")
will fail 100% of the time with a puzzling Out of Memory error, followed by a 1004: Method open of object workbooks failed, if and only if the excel file contains any macros whatsoever. These can be in modules, forms, or ThisWorkbook macros.

The same file can be opened with no error by either saving the file locally first ( Workbooks.open("Drive:test.xls") ), or by removing absolutely all of the file's macros.
Have tried the most recent excel update for 2004 (11.2.3), but it hasn't fixed it.

This still works fine, though, in Excel V.x (mac) as well as 2002 (win).

Is anybody aware of a workaround (can VB download a file to a local folder without opening it first?). All help appreciated, I'd really like to be using 2004 instead.

Hi Guys,

I am trying to update specific fields of table in Ms Access, through Excel VBA. My select and add new record queries work, but the update query always throws the RUN TIME ERROR 80040e10 - "No Value Given To One or More Required Parameters"

I have checked my table name and the other field names over and over again, but I see nothing wrong with the quesry. I am trying to update a few fields from the database, for a existing record number (autonumber).

Function CheckDB(Serial_No_New_Part As String, Serial_No_Failed_Part As String, ConStr As
String) _ 
    As Boolean 
    Dim MsgBox_Answer As Integer 
     
    ' Variable stores ADO Connection Object to Ms Access DB
    Dim cnt As New ADODB.Connection 
     
    ' Variable for Recordset Object
    Dim rst As New ADODB.Recordset 
     
    ' Variable stores Database path
    Dim strDB As String 
     
     
    ' Variable stores SQL 'SELECT' Query
    Dim SQLSelectNewPart As String 
    Dim SQLSelectFailedPart As String 
    Dim SQLUpdate As String 
     
    Dim Primary_No_Failed_Part As Long 
    Dim Run_Time_Hrs_Failed_Part As Long 
    Dim Part_Status_Failed_part As String 
    Dim Date_Failed_Failed_part As Date 
    Dim Failed_Location_Failed_Part As String 
    Dim Failure_History_Failed_Part As String 
    Dim Description_Failed_Part As String 
     
    ' Set the string to the path of your database
    strDB = ConStr 
     
    ' Open connection to the database
    cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
    "Data Source=" & strDB & ";" 
     
    rst.Open SQLSelectNewPart, cnt, adOpenDynamic, adLockBatchOptimistic, adCmdText 
     
     
    ' In simple words, look whether any records in the DB contain the same "Part_Serial_No"
    ' Check whether recordset is empty,implies no records found
    ' BOF = Begining of File
    ' EOF = End of File
    ' IF ((Not BOF = TRUE) AND (Not EOF = TRUE)), Implies Records Have Been Found
    If (rst.BOF = False And rst.EOF = False) Then 
         'Primary_Key = rst.Fields("Primary_No").Value
         
        MsgBox_Answer = MsgBox("A part with the matching 'Serial No' already exists in the Database" _ 
        & vbCrLf & "Click on the 'OK BUTTON' to display the 'ADD REPAIRED PART FORM'" & vbCrLf & _

        "or click on the 'CANCEL BUTTON' to edit the 'ADD NEW/REPLACE OLD FORM'", vbOKCancel, _ 
        "Existing Part in Database") 
         
        If (MsgBox_Answer = 1) Then 
             
            'Temporary Storage - Retrieve Existing Failed Tage Info from Database
            'Store this info temporarily on Sheet7 - Row(2-3), Column 5
            Sheet7.Cells(2, 5).Value = CLng(rst.Fields("Primary_No").Value) 
            
            'Failed Part Row No on Sheet1 retrieved from UserForm6
            Sheet7.Cells(3, 5).Value = CLng(UserForm6.TextBox17.Value) 
            
            'Write DB Path
            Sheet7.Cells(4, 5).Value = UCase(CStr(strDB)) 
             
             
            'Close Connection Objects and Recordset Objects.
            ' Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
             
             
            CheckDB = False 
             
            Unload UserForm6 
            UserForm1.Show 
             
        ElseIf (MsgBox_Answer = 2) Then 
            CheckDB = False 
             
            'Close Connection Objects and Recordset Objects.
            'Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
            Exit Function 
        Else 
            CheckDB = False 
             
            'CloseConnection Objects and Recordset Objects.
            'Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
            Exit Function 
        End If 
         
    'Else no records have been found - Implies New Part is New and is not a Failed part that has been repaired
    'Check whether Failed Part exists in DB
    'If Failed Part Exists, Append existing record
    'Else Add New Record for Failed Part in DB
    Else 
        rst.Close 
        'Now check whether Failed Part exists in DB
        SQLSelectFailedPart = "Select * FROM Failed Where Serial_No= '" _ 
        & UCase(CStr(Serial_No_Failed_Part)) & "'" 
         
        'Open recordset based on Trial table
        rst.Open SQLSelectFailedPart, cnt, adOpenDynamic, adLockBatchOptimistic, adCmdText 
         
        If (rst.BOF = True And rst.EOF = True) Then 
             
            'Add Failed Part Data as a new Record
            'Close Open Recordset
            rst.Close 
             
            '*********START Procedure to Add New Record********
            rst.Open "Failed", cnt, adOpenKeyset, adLockOptimistic, adCmdTable 
            rst.AddNew 
            rst!Part = UCase(CStr(UserForm6.TextBox14.Value)) 
            rst!Serial_No = UCase(CStr(UserForm6.ComboBox3.Value)) 
            rst!Material_Type = UCase(CStr(UserForm6.TextBox9.Value)) 
            rst!Run_Time_Hours = CLng(UserForm6.TextBox10.Value) 
            rst!Current_Part_Status = UCase(CStr(UserForm6.ComboBox4.Value)) 
            rst!Date_Failed = Format(CDate(UserForm6.TextBox12.Value), "mm/dd/yyyy") 
            rst!Failed_Location = UCase(CStr(UserForm6.TextBox15.Value)) 
            rst!Vendor_Name = UCase(CStr(UserForm6.TextBox13.Value)) 
             
            rst!Description = Replace(UCase(CStr(UserForm6.TextBox19.Value)), Chr(34), "''") 
            rst.Update 
             
            CheckDB = True 
             
            'close Connection Objects and Recordset Objects.
            'Close ADO objects
            rst.Close 
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
             
             
        'If existing record found, then Append and Update existing record
        Else 
            Primary_No_Failed_Part = rst.Fields("Primary_No").Value 
             
            Decription_Failed_Part = Replace(UCase(CStr(rst.Fields("Description").Value)), _ 
            Chr(34), "'") 
             
            Part_Status_Failed_part = UCase(CStr("Failed")) 
             
            Run_Time_Hrs_Failed_Part = CLng(rst.Fields("Run_Time_Hours")) 
             
            Date_Failed_Failed_part = Format(rst.Fields("Date_Failed"), "mm/dd/yyyy") 
             
            Failed_Location_Failed_Part = UCase(CStr(rst.Fields("Failed_Location"))) 
             
            'Close open RecordSet
            rst.Close 
             
            Failure_History_Failed_Part = UCase(CStr("Run Time Hours = " & Run_Time_Hrs_Failed_Part & _ 
            vbCrLf & "Date_Failed = " & Format(CDate(Date_Failed_Failed_part), "dd,mmm,yyyy")
& _ 
            vbCrLf & "Failure_Location = " & Failed_Location_Failed_Part & vbCrLf & _ 
            "---------------------------------------" & vbCrLf)) 
             
            Description_Failed_Part = UCase(CStr(vbCrLf & "-----------------------------------" & vbCrLf
& _ 
            UCase(CStr(UserForm6.TextBox19.Value)))) 
             
            Description_Failed_Part = Replace(Description_Failed_Part, Chr(34), "''") 
             
             
            'SQL UPDATE QUERY
            SQLUpdate = "UPDATE Failed SET [Run_Time_Hours] = " & CLng(UserForm6.TextBox10.Value) & _ 
            ", [Current_Part_Status] = '" & UCase(CStr(Part_Status_Failed_part)) & _ 
            "', [Date_Failed] = " & CDate(UserForm6.TextBox12.Value) _ 
            & ", [Failed_Location] = '" & UCase(CStr(UserForm6.TextBox15.Value)) & _ 
            "', [Failure_History] = '" & Failure_History_Failed_Part & _ 
            "', [Description] = '" & Description_Failed_Part & _ 
            "' WHERE Failure.Primary_No = " & CLng(Primary_No_Failed_Part) 
             
             
            'ERROR on this statement
            cnt.open SQLUpdate             
             
            CheckDB = True 
             
            'close Connection Objects and Recordset Objects.
            'Close ADO objects
            cnt.Close 
            Set rst = Nothing 
            Set cnt = Nothing 
             
            Unload UserForm6 
        End If 
         
    End If 
End Function
Could someone point our what I am doing wrong. The error occurs on the statement
VBA:
cnt.open SQLUpdate

ERROR: RUN TIME ERROR: 80040e10 - "No Value Given To One or More Required Parameters"

Thanks.

Regards,

Cnerurkar

Hello,
I have a large workbook (50 sheets) that contains a sheet for each employee. I have VBA code that recognizes the user's login and only displays the sheet that belongs to that user. However, to allow all users access simultaneously, I have made it a shared workbook. I receive a Run-Time Error 1004 when the workbook is placed into shared mode and it will not function correctly. However, if I remove the shared feature it runs fine (I just can't have everyone in it making updates).

Any suggesions?

Thanks!

I just discovered my problem lies in protecting the workbooks. I guess you can't have protected sheets in a shared workbook. Does anyone know how to still protect sheets in shared workbooks?

Hi I am trying to do something simple but I am getting an error:

"Invalid Outside Procedure"

It highlights the path of my file:

Dim excelApp As Excel.Application
Dim wr1 As Excel.Range
Dim SigString As String
Dim Signature As String
Dim Sheet1 As Excel.Worksheet


    Workbooks.Open Filename:="d:test.xls", UpdateLinks:=0 _
        , ReadOnly:=True, Notify:=False
    
 Windows("test.xls").Activate
    Range("A1").Select
    Selection.Copy
    Windows("test.xls").Activate
    Range("C1").Select
    
End


Application.Quit


I keep encountering the following message whilst trying to filter data via macro.

Here is an example of the offending code - I'm very new to VBA so please assume I have little/no knowledge. Many thanks in advance

Sometimes this code does execute but the majority of the time it doesn't - and I certainly wouldn't know why!

I've tried fully qualifying the range for the filter criteria but this has made no difference. Any thoughts?

Also, it appears that after running other advanced filters (from early code) the worksheet is getting stuck with some rows as hidden (or row numbers highlighted blue). The code at the top of the sub-routine don't seem to do anything about this.


	VB:
	
Sheets("Data Input & Format").Select 
If ActiveSheet.AutoFilterMode = True Then 
     
    ActiveSheet.AutoFilterMode = False 
     
Else 
     
End If 
 
If ActiveSheet.FilterMode = True Then 
    ActiveSheet.FilterMode = False 
     
Else 
     
End If 
 
Range("AH7:AM50000").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange _ 
:=ThisWorkbook.Sheets("Data Input Support").Range("R6:R7"), Unique:=False 
 
Dim rng3 As Range 
Set rng3 = Worksheets("Data Input & Format").Columns("AH:AM") 
Set rng3 = rng3.Resize(50000, 1).Offset(7, 0) 
Set rng3 = rng3.Resize(, 6).SpecialCells(xlCellTypeVisible) 
 
rng3.Copy 
 
Sheets("Record Errors").Select 
Range("H6").Select 
If Range("H6").FormulaR1C1 = "" Then 
    ActiveSheet.Paste 
Else 
    Range("H6").Select 
    Selection.End(xlDown).Select 
    ActiveCell.Offset(1, 0).Select 
    ActiveSheet.Paste 
End If 
 
 
 
Sheets("Data Input & Format").Select 
 
 
ActiveSheet.ShowAllData 
 
 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines


Hi Guys,

Got a strange one here...
I have a macro that checks if a username is in a particular list, and if it is, it unhides certain sheets in the workbook.

The code runs fine if I just run it as a macro or off a command button, but I am trying to execute it when the workbook opens and I keep getting a 57121, Application defined or object defined error.

The code is below;


	VB:
	
 Workbook_Open() 
     
    DoEvents 
     
    Dim Res1 As VbMsgBoxResult 
    Dim GovRng As Range 
     
    For Each GovRng In Sheets("Map").Range("GovernanceMembers") 
        If GovRng.Value = Application.UserName Then Goto 111 
    Next GovRng 
     
    Exit Sub 
     
    111 
    Res1 = vbNo 
     
    Res1 = MsgBox("You are a Governance Team Member," & _ 
    "would you like to unlock the workbook?", vbYesNo, "Unlock Workbook?") 
     
    If Res1 = vbYes Then 
        Sheets("Map").Visible = xlSheetVisible 
        Sheets("Map").Select 
        Sheets("Map").Activate 
    End If 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Any ideas much appreciated. Cheers,
Ian

Hi All,

My VB project is coming along just fine, but I'm stuck on this on
thing.. When I open files from a listbox (multiSelect) I want to call
function to format the just opened workbooks. What happens now is tha
the called function is running on the workbook containing th
macro/form.

Instead of calling the function I've written a line to activate cel
A3, which it selects on the macro/form workbook, not the just opene
workbooks as it is supposed to.

iDestRow = 1
With Me.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then

Excel1.Visible = True
Excel1.Workbooks.Open _
Filename:=.List(i, 0), _
Format:=xlCSV, _
Delimiter:=",", _
ReadOnly:=True

Range("c3").Select

I've been thinking about using .List(i, 0) as a reference to activat
workbooks, but I can't find any info about activating workbooks o
variables...

If you need more code or info, please let me know!

Many thanks!

Joos

--
Message posted from http://www.ExcelForum.com

I was using the workbooks.open with a password provided to open a workbook on web server
password is included, but the prompt is still coming out


	VB:
	
 workbook 
Dim wbFullPath As String 
Dim pw As String 
 
wbFullPath = common.GetWorkbookPath() 
 'Link to server e.g. [URL]http://xxx.com/excel.xls[/URL]
pw = common.GetWorkbookPassword() 
 
Set wb = workbooks.open(wbFullPath, Password:= pw, Readonly:= True) 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
During debug, I could see the pw being correct and seems doing well
There's no second password for modification,
but the password prompt was still poping up!

Does anyone know how to stop that prompt?
or why was the password not passed properly?

additional info:
The codes above had been working fine on my computer
but not so when it is on the user's computer!

is there a way to get into the debugger just as i open excel (and enable macros)

i am currently trying to debug a file but the error occurs in the Workbook Open method.

i cant figure out a way to get into the debugger before the error happens, is this even possible? thanks.

Hello, I'm trying to copy, using code, a sheet to another workgroup.
I make this steps: Create a new file with name "file1.xlsx" and select the "totais" sheet from the "oldfile.xlsx" and when the code do the move command it gives an error : "run-time error 1004: Excel cannot insert the sheets into the destination workbook, because it contains fewer rows and columns than the source workgroup...".
They advise to copy only the cells that have data.
My source file has 1048576 rows by 'XFD' columns and the destination only has 65536rows by 'IV' columns.
i don't know why my source file has so many columns and rows. I don't need them...
Any help?
Code:

If NumTrab = 0 Then 'Se seleccionou TUDO então faz:
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=TempFile, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
TempFile = ActiveWorkbook.Name
Windows(FicheiroActual).Activate
If Cb_5.Value = True Then 'TOTAIS ANO
Call TotaisAno
Sheets("TOTAIS").Move Before:=Workbooks(TempFile).Sheets(1)
End If
If Cb_2.Value = True Then 'Horas Trabalhadas
For x = 0 To UBound(ListaPessoal)
Nome = ListaPessoal(x, 1)
Call FazFolhaPessoal(Nome)
If FolhaInexistente = False Then
Workbooks(FicheiroActual).Sheets(ListaPessoal(x, 1)).Move After:=Workbooks(TempFile).Sheets(1)
End If
Next x
End If
If Cb_4.Value = True Then 'Horas de Acerto Mensais
Call Calcula_HA_Mensal
Workbooks(FicheiroActual).Sheets("Horas Acerto Mensal").Move Before:=Workbooks(TempFile).Sheets(1)
End If
If Cb_3.Value = True Then 'HCI's Mensais
Call Calcula_HCI_Mensal
Workbooks(FicheiroActual).Sheets("HCI Mensal").Move Before:=Workbooks(TempFile).Sheets(1)
End If

Workbooks(TempFile).Save 'Guarda Ficheiro
Workbooks(TempFile).Close
A = MsgBox("Dados gravados com sucesso no ficheiro " & TempFile, vbInformation + vbOKOnly)
Exit Sub
End If

Thank you,

Mário

Hello,

Trying to in excel macro to open up Google Chrome and open a webpage, then refresh the webpage and then close the webpage.

Hi,

I have access to two e-mailboxes at work, so in addition to sending emails from my normal address (i.e. my name) I can send them out of the department mailbox.

I have created a form which includes a "From" field, so I can specify that I want a message to come From the department mailbox.

Can anyone tell me how to get Excel VBA to open that form and send a message from this other email address? I found some code online which lets me send messages from my default email address, but how can I get it to send from the other one? .From appears to be an invalid property. Any help? Thanks!

I have a macro called "UpdateAllPayouts" that lives in a workbook whose name is stored in the variable sPCFactorsWB. The following partial code is from a Private Sub in ThisWorkbook. When I run the code I get error:1004, the macro "Workbook.xls!UpdateAllPayouts" cannot be found. The macro UpdateAllPayouts is a Public sub.

Workbooks(sPCFactorsWB).Activate
Application.Run (sPCFactorsWB & "!UpdateAllPayouts")

What are the conditions under which Application.Run will work?

I've looked around and it seems no one has had a similar issue to me that was asked online... Shocker, I know.

At any rate, this is what I am trying to do:
I have a workbook that when I open it I want it to open a form that asks me to put in a date. I hit submit with the date and opens a dialogue box that lets me select multiple files and it pulls data off of those files and puts the date from the form in the data on the originally opened book.
My issue is that if I select multiple files to import into the original workbook, each time the new file opens it runs my 'On Open' event but I only need it to run on the opening of the original workbook.

Here is my code for my On Open Event and my 'Open Form' code:


	VB:
	
 Workbook_Open() 
    Call OpenForm 
     
End Sub 
 
 
Sub OpenForm() 
    frmDate.Show 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
Code for my submit button on my form:


	VB:
	
 btnSubmit_Click() 
    txtdate.Value = ReportDate 
    Run "ImportGP" 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
And then finally my actual code for the importing of the files:


	VB:
	
 ImportGP() 
    Dim fso As Object 
    Dim fd As FileDialog 
    Dim vrtSelectedItem As Variant 
    Dim Data_Book As String 
    Dim Entry_Book As String 
    Dim Data_Row As Integer 
    Dim Entry_Row As Integer 
    Set fd = Application.FileDialog(msoFileDialogFilePicker) 
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 
    Entry_Book = ThisWorkbook.Name 
    Entry_Book_Path = ThisWorkbook.Path 
    Entry_Row = 2 
    With fd 
         
        .AllowMultiSelect = True 
        .InitialFileName = Entry_Book_Path 
        If .Show = -1 Then 
             
            For Each vrtSelectedItem In .SelectedItems 
                 
                Data_Row = 2 
                Data_Book = Dir(vrtSelectedItem) 
                Workbooks.Open Filename:=vrtSelectedItem 
                Workbooks(Data_Book).Sheets(1).Columns("C:C").Delete Shift:=xlToLeft 
                Workbooks(Data_Book).Sheets(1).Range("B1") = "Employee Name" 
                Workbooks(Data_Book).Sheets(1).Range("D2") = ReportDate 
                 
                Do Until Workbooks(Data_Book).Sheets(1).Cells(Data_Row, 1) = "" 
                     
                    If Workbooks(Data_Book).Sheets(1).Cells(Data_Row, 2) = "Team ID, Team ID" Then 
                         
                        Workbooks(Data_Book).Sheets(1).Rows(Data_Row).Delete Shift:=xlUp 
                        Data_Row = Data_Row - 1 'since deleted row
                         
                    End If 
                     
                    Data_Row = Data_Row + 1 
                     
                Loop 
                 
                Workbooks(Data_Book).Sheets(1).Range("D2").Copy 
                Workbooks(Data_Book).Sheets(1).Range("D2:D" & Range("C" & Rows.Count).End(xlUp).Row).PasteSpecial
Paste:=xlPasteValues 
                Workbooks(Data_Book).Sheets(1).Range("A2:C" & Range("C" & Rows.Count).End(xlUp).Row).Copy 
                Workbooks(Entry_Book).Sheets(1).Range("A" & Entry_Row).PasteSpecial Paste:=xlPasteValues 
                Application.CutCopyMode = False 
                 
                Windows(Data_Book).Close savechanges:=False 
                 
                Entry_Row = Workbooks(Entry_Book).Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row 
                 
            Next 
             
        Else 
        End If 
    End With 
    Set fd = Nothing 
    Application.ScreenUpdating = True 
    Application.Calculation = xlCalculationAutomatic 
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
If anyone can help me with this it would be greatly appreciated.

Thanks,
Jessica

Hello, I am getting a run time error on the following line of my code (entire
code below). Basically I am trying to print files that are listed in the
cells. Any help is appreciated. Thanks.

*** Line erroring out***
Set bk = Workbooks.Open(cell.Name)

***Entire code***

Sub printfromqueue()
Dim usrid As String
Dim sh As Worksheet
Dim rng As Range
Dim bk As Workbook
Dim cell As Range
usrid = Environ("Username")
Set sh = Workbooks(usrid & ".xls").Worksheets("Sheet1")

Set rng = sh.Range(sh.Cells(1, 1), sh.Cells(1, 1).End(xlDown))

For Each cell In rng

Set bk = Workbooks.Open(cell.Name)

Finalize 'print macro
bk.Close Savechanges:=False
Next

End Sub

Hi all!
I´m running an outlook code in excel VBA to open an email, input To and CC addresses, subject, text and an attachment.
What is being really tricky to me is how can i open this attachment.

Private Sub cmd_OK_Click()
Dim newmail As Object
Set newmail = CreateObject("Outlook.Application")
Set NM = newmail.CreateItem(olMailItem)
NM.To = "email1@test.com"
NM.cc = "#email2@test.com"
NM.Subject = "attachment tests"
Set attach = NM.Attachments
attach.Add "c:test.xls"
NM.display
End Sub
this piece of code, creates an objetc (new email), addresses it to email1@test.com, cc it to email2@test.com, with subject "attachment tests", and attaches the spreadsheet test.xls. What i want is to open this attachment from the email opened, not the file save in C:.
Can anyone help me??
Thanks a lot.

Hello,

I have an excel spreadsheet that uses a macro to open
another excel spreadsheet via Workbooks.Open(filename)

On my local drive this works fine and it opens the second
file, runs the query, and closes it without complaint.
When I run it via a network drive it works fine as well.

However, when I try to run it via a browser (i.e. put the
file on a web server and then open the url as
http://www.whatever.com/myfile.xls") and then run the
macro I get a runtime error 1004 stating "Method 'Open' of
object 'Workbooks' failed".

Any idea what is causing this?

To complicate matters more, when it gives me the error it
gives me the option of "End" or "Debug". If I click Debug
it brings up the code window. If I then click Run without
making any changes it runs properly.

Help!

Thanks,

Ken Hunter

Hello:
I am a beginner in VBA for excel. I am trying to make a code that works on the workbook open event, and after looping thru a series of 10 worksheets searching for values to copy and paste in another worksheet, the code opens another workbook (with a different name), and loops thru another series of 10 worksheets that have the same name as the above mentioned searching for values to copy and paste in the same worksheet of the first open workbook. When the code tries to open the second workbook, I keep getting the runtime error 1004, error on method Open on workbooks object. Any ideas about this problem?

The code I am running is as follows:

	VB:
	
 Workbook_Open() 
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 
     
     '  La siguiente seccion del codigo se encarga de activar la hoja2 (Equipos) y _
     '  Protegerla contra escritura, permitiendo la edicion de las celdas no protegidas _
     '  y el uso de agrupar/desagrupar datos.
     
    Hoja2.Activate 
    Range("a1").Activate 
    Hoja2.Protect Password:="", DrawingObjects:=False, Contents:=True, Scenarios:=False, _ 
    UserInterfaceOnly:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _ 
    AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, _ 
    AllowInsertingHyperlinks:=True 
    Hoja2.EnableOutlining = True 
     
     '  La siguiente seccion del codigo se encarga de verificar la fecha de actualizacion
     '  de los listados de materias primas del archivo actual.
     
    Dim Contador_LEP As Integer 
    Dim Inicio As Integer 
    Dim Final As Integer 
    Dim Texto As String 
     
    Inicio = Sheets("Grupos de Recursos").Range("a3") 
    Final = Sheets("Grupos de Recursos").Range("a12") 
     
    For Contador_LEP = Inicio To Final 
        Texto = Sheets("Grupos de Recursos").Range("b" & 3 + Contador_LEP & "") 
        If Sheets("GR0" & Contador_LEP & " - " & Texto & "").Visible = False Then 
            Sheets("GR0" & Contador_LEP & " - " & Texto & "").Visible = True 
        Else 
        End If 
        Sheets("GR0" & Contador_LEP & " - " & Texto & "").Select 
        Range("xfd2").Activate 
        Selection.End(xlToLeft).Select 
        Selection.Copy 
        Application.Goto Reference:="EP.Fecha.GR0" & Contador_LEP & "" 
        ActiveSheet.Paste 
        Sheets("GR0" & Contador_LEP & " - " & Texto & "").Visible = False 
         
    Next Contador_LEP 
     
     ' La siguiente parte del codigo verifica cual fue la ultima fecha de actualizacion _
     ' del listado de materias primas del archivo maestro.
     
    Workbooks.Open "c:fibratorebase de datos principal fibratore.xlsm" 'Here is were I get the error
     
    For Contador_LEP = 0 To 9 
         
        Windows("Base de Datos Principal Fibratore.xlsm").Activate 
        Application.Goto Reference:="EP.Fecha.GR0" & Contador_LEP & "" 
        Selection.Copy 
        Windows("Laminados de Equipos Principales.xlsm").Activate 
        Application.Goto Reference:="EP.Fecha.GR0" & Contador_LEP & ".VMR" 
        ActiveSheet.Paste 
         
    Next Contador_LEP 
     
    Application.CutCopyMode = False 
    Windows("Base de Datos Principal Fibratore.xlsm").Activate 
    Application.ActiveWindow.Close 
     
    Sheets("Equipos").Outline.ShowLevels Rowlevels:=1 
    Application.Calculation = xlCalculationAutomatic 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines
The workbook that I try to open when I get the error, also runs a code on the workbook open event. The code it runs is as follows:

	VB:
	
 Workbook_Open() 
     
    Application.ScreenUpdating = False 
     
    Dim Contador_BDP As Integer 
    Dim Inicio_BDP As Integer 
    Dim Final_BDP As Integer 
    Dim Texto_BDP As String 
     
    Inicio_BDP = Sheets("Grupos de Recursos").Range("a3") 
    Final_BDP = Sheets("Grupos de Recursos").Range("a12") 
     
    For Contador_BDP = Inicio_BDP To Final_BDP 
        Texto_BDP = Sheets("Grupos de Recursos").Range("b" & 3 + Contador_BDP & "") 
        If Sheets("GR0" & Contador_BDP & " - " & Texto_BDP & "").Visible = False Then 
            Sheets("GR0" & Contador_BDP & " - " & Texto_BDP & "").Visible = True 
        Else 
        End If 
        Sheets("GR0" & Contador_BDP & " - " & Texto_BDP & "").Select 
        Range("xfd2").Activate 
        Selection.End(xlToLeft).Select 
        Selection.Copy 
        Application.Goto Reference:="EP.Fecha.GR0" & Contador_BDP & "" 
        ActiveSheet.Paste 
        Sheets("GR0" & Contador_BDP & " - " & Texto_BDP & "").Visible = False 
        ActiveWorkbook.Save 
    Next Contador_BDP 
     
    Hoja2.Outline.ShowLevels Rowlevels:=1 
    Hoja1.Activate 
    Range("a1").Activate 
     
End Sub 

If you like these VB formatting tags please consider sponsoring the author in support of injured Royal Marines



No luck finding an answer? You could always try Google.