Run-time error '1004': error

soupi

Board Regular
Joined
Mar 31, 2014
Messages
61
My friend was running a report and received this error "Method 'Publish' of object 'PublishObject' failed"
I ran the same file on my computer and it ran without a issue….
Then I remoted into her computer to reupload the MACROS, which didn’t help… What boggles me is that I ran an old FOC report on her computer and it ran without a problem, and then got todays file from the web and ran it and received the same error, do you have a idea as to why?

[COLOR=blue !important][COLOR=blue !important]screen [COLOR=blue !important]shots[/COLOR][/COLOR][/COLOR] are attached.... any comments will be helpful.. thank you
343969d1410206694-run-time-error-1004-error-ddd.jpg
343970d1410206695-run-time-error-1004-error-sddd.png
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Here is the code of the macro I am running, in the red is were the error happens... Im not sure why it is happening since I relodeded macros and it still errors out...


Code:
Sub RequestNetSave()
Application.DisplayAlerts = False

   Columns("K:K").Select
    Columns("K:K").EntireColumn.AutoFit
'Dim OnlyOne
'OnlyOne = "MoreThanOne"

'Range("A2").Select
'
'If ActiveCell.Offset(1, 0).Value = "" Then
'  OnlyOne = "One"
'End If
 Dim ThePath
 ThePath = ActiveWorkbook.Path
' previous code
' Range("A1").Select
'    ActiveCell.SpecialCells(xlLastCell).Select
'    ActiveCell.Offset(0, -5).Select
'
'    'Range("M25").Select
'    Range(Selection, Cells(1)).Select
    
  Range("A1").Select
    
      Columns("A:A").Select
    Selection.Find(What:="Report run on", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
        
        ActiveCell.Select
        
              
        Dim myAddress
        myAddress = ActiveCell.Address
        
        Range("A1").Select
        Range(Selection, myAddress).Select
     
    Range(Selection, Selection.Offset(0, 12)).Select
    
    
    
    Dim currSelection As Range
    Set currSelection = Application.Selection
    Dim mySelection As String
    mySelection = currSelection.Address
    
    
[COLOR=#B22222]    With ActiveWorkbook.PublishObjects.Add(xlSourceRange, _
        ThePath & "\SR_Hit_List.htm" _
        , "Completed file", mySelection, xlHtmlStatic, "GetWgAssignStatus_25614", _
        "")
        .Publish (True)
        .AutoRepublish = False
    End With[/COLOR]
[COLOR=#B22222] [/COLOR]
'      , "Completed file", "$A$2:$M$25", xlHtmlStatic, "OSP FOC 2012 02 10 pm_25614", _

' end save as web page

 Dim DtToday As String
 Dim MyDate
 MyDate = Date
 Dim TheYear
 Dim TheMonth
 Dim TheMonthStr
 Dim TheDay
 Dim TheDayStr
 
 TheYear = DatePart("yyyy", MyDate)
 TheMonth = DatePart("m", MyDate)
 TheDay = DatePart("d", MyDate)
 TheMonthStr = Trim(Str(TheMonth))
 TheDayStr = Trim(Str(TheDay))
 If TheMonth < 10 Then TheMonthStr = "0" & TheMonthStr
 If TheDay < 10 Then TheDayStr = "0" & TheDayStr
 DtToday = TheYear & " " & TheMonthStr & " " & TheDayStr

 Dim CompleteSavedFileName
' Dim UserMonthTextInput
  
'ThePath = ActiveWorkbook.Path
  
' UserMonthTextInput = InputBox("Enter the month in text form to start building the file name")
  
  Dim myTimeForFilename
  
  
 UserForm1.Show
With UserForm1
 myTimeForFilename = UserForm1.ListBox1.Value
  
End With

Unload UserForm1
  
  
  
  
  
 CompleteSavedFileName = ThePath & "\OSP FOC " & DtToday & ".xls"
 
 
 If myTimeForFilename = "Noon" Then
 
 CompleteSavedFileName = ThePath & "\OSP FOC " & DtToday & " Noon.xls"
 
 End If
 
 If myTimeForFilename = "PM" Then
 
 CompleteSavedFileName = ThePath & "\OSP FOC " & DtToday & " pm.xls"
 
 End If
 
    
     ActiveWorkbook.SaveAs fileName:=CompleteSavedFileName, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
       
       
       
       
     
 
    Range("A1").Select
    
      Columns("A:A").Select
    Selection.Find(What:="Report run on", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
        
        ActiveCell.Select
        
        ActiveCell.Offset(-4).Select
        
    
        
        
        myAddress = ActiveCell.Address
        
        Range("A1").Select
        Range(Selection, myAddress).Select
     
    Range(Selection, Selection.Offset(0, 12)).Select

' previous code
' Range("A1").Select
'    ActiveCell.SpecialCells(xlLastCell).Select
'    ActiveCell.Offset(-4, -10).Select
    
 '   'Range("M25").Select
 '   ' PROBLEM?  1/20/2014
 '   Range(Selection, Cells(1)).Select
    
    
    Dim currSelection2 As Range
    Set currSelection2 = Application.Selection
    
   
   Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       currSelection2, Version:=xlPivotTableVersion12). _
        CreatePivotTable TableDestination:="Sheet3!R3C1", TableName:="PivotTable1" _
        , DefaultVersion:=xlPivotTableVersion12
        
'    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
'        currSelection2, Version:=xlPivotTableVersion12). _
'        CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable1" _
'        , DefaultVersion:=xlPivotTableVersion12
        
        
        
    Sheets("Sheet3").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("OSP Target")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("SR-ID"), "Count of SR-ID", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Group Name")
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
    Range("B7").Select
    ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleMedium9"
    Range("B4").Select
    
    'Problem Here ? ==============================
    
 '   If OnlyOne = "MoreThanOne" Then
      With ActiveSheet.PivotTables("PivotTable1").PivotFields("OSP Target")
         .PivotItems("(blank)").Visible = False
      End With
 '   End If
    
    '==============================================
   
    Range("B4").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B4").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With

 Rows("4:4").Select
    Selection.RowHeight = 52.5
    Columns("B:B").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Columns("B:N").Select
  
    Selection.ColumnWidth = 12.57
    Range("A1").Select

RequestNetSave2
Application.DisplayAlerts = True

MsgBox ("Macro Complete")

End Sub

Sub RequestNetSave2()
    Sheets("Completed file").Select
    Range("A2").Select
    
 Sheets("Sheet3").Select

 Range("A5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.NumberFormat = "[$-409]m/d/yyyy h:mm AM/PM;@"

 Dim DtToday As String
 Dim MyDate
 MyDate = Date
 Dim TheYear
 Dim TheMonth
 Dim TheMonthStr
 Dim TheDay
 Dim TheDayStr
 
 TheYear = DatePart("yyyy", MyDate)
 TheMonth = DatePart("m", MyDate)
 TheDay = DatePart("d", MyDate)
 TheMonthStr = Trim(Str(TheMonth))
 TheDayStr = Trim(Str(TheDay))
 If TheMonth < 10 Then TheMonthStr = "0" & TheMonthStr
 If TheDay < 10 Then TheDayStr = "0" & TheDayStr
 DtToday = TheYear & "_" & TheMonthStr & "_" & TheDayStr
Dim myPath
myPath = ActiveWorkbook.Path

  ActiveSheet.PivotTables("PivotTable1").PivotSelect "", xlDataAndLabel, True
    With ActiveWorkbook.PublishObjects.Add(xlSourcePivotTable, _
        myPath & "\SR_Hit_List_Pivot.htm" _
        , "Sheet3", "PivotTable1", xlHtmlStatic, "OSP FOC " & DtToday & "_17222", "")
        .Publish (True)
        .AutoRepublish = False
    End With

 Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Pivot"
    
    
     Range("A1").Select
    
    ActiveWorkbook.save
    

End Sub
 
Upvote 0
That portion of your code worked for me when I tested it. Has the workbook been saved and is the ActiveSheet named "Completed file"?
 
Upvote 0
yes the name is completed file for the active sheet ... and the workbook meaning the site that it produces?
 
Upvote 0
Yes the html file is getting saved in the location of the xls file that i am running the file one.. is there a way to chec kit
 
Upvote 0

Forum statistics

Threads
1,213,513
Messages
6,114,064
Members
448,545
Latest member
kj9

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