VBA将Excel文件上传到Sharepoint。运行时错误'1004'

时间:2017-03-22 09:37:53

标签: excel vba excel-vba sharepoint runtime-error

大家好,我希望你能提供帮助。我有一段代码,如果将单元格A2更改为“在此输入您的国家/地区”以外的任何内容,它会找到并使用A2中的新值替换工作簿中的所有“输入您的国家/地区”。这部分工作正常。我遇到的问题是,一旦发生单元格更改,我还希望工作簿保存到我们的Sharepoint环境中。但我继续在以下一行运行时错误'1004'

SaveAs Filename:="http://teamspace.merck.com/sites/emea_efpia/Shared%20Documents/Forms/AllItems.aspx?RootFolder=%2Fsites%2Femea%5Fefpia%2FShared%20Documents%2FEFPIA%20Regional%20Reporting%20Team%2FDispute%20Management%2FDispute%20reports%20per%20market%2FGlobal%20Reporting&FolderCTID=0x012000FA7F4E9565D6274DAF9E871EA008299B&View=%7BB6EF0397-E24C-49DF-92EF-CB7015B60539"

如果我用C驱动器或本地地址替换Sharepoint地址,它可以很好地工作。我错过了什么吗?我的代码可以修改为允许将工作簿保存到Sharepoint吗?我的代码在下面,一如既往,我们非常感谢所有的帮助。

代码

Private Sub Worksheet_Change(ByVal Target As Range)

  ThisFile = Range("A2").Value
  Dim cell As Range
  Dim sht As Worksheet
  Dim fnd As Variant
  Dim rplc As Variant

  fnd = "Enter Your Country Here"
  rplc = Worksheets("SearchCasesResults").Range("A2").Value
  For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
  LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
  SearchFormat:=False, ReplaceFormat:=False
  Next sht
  For Each cell In Range("A2")
  If cell.Value <> "Enter Your Country Here" Then
  SaveAs Filename:="http://teamspace.merck.com/sites/emea_efpia/Shared%20Documents/Forms/AllItems.aspx?RootFolder=%2Fsites%2Femea%5Fefpia%2FShared%20Documents%2FEFPIA%20Regional%20Reporting%20Team%2FDispute%20Management%2FDispute%20reports%20per%20market%2FGlobal%20Reporting&FolderCTID=0x012000FA7F4E9565D6274DAF9E871EA008299B&View=%7BB6EF0397-E24C-49DF-92EF-CB7015B60539"
  End If
  Next cell
  Worksheets("SearchCasesResults").Activate
  ActiveWorkbook.Close

End Sub

按要求新编码

    Private Sub Worksheet_Change(ByVal Target As Range)

  ThisFile = Range("A2").Value
  Dim cell As Range
  Dim sht As Worksheet
  Dim fnd As Variant
  Dim rplc As Variant

  fnd = "Enter Your Country Here"
  rplc = Worksheets("SearchCasesResults").Range("A2").Value
  For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
  LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
  SearchFormat:=False, ReplaceFormat:=False
  Next sht
  For Each cell In Range("A2")
  If cell.Value <> "Enter Your Country Here" Then
  Application.SaveAs Filename:="\\teamspace.merck.com\sites\emea_efpia\Shared%20Documents\EFPIA%20Regional%20Reporting%20Team%2FDispute%20Management\Dispute%20reports%20per%20market\Global%20Reporting\["C:\Users\CONNELLP\Desktop\Claire Macro\CRO Countries\" & ThisFile & Format(Now(), "DD-MMM-YYYY hh mm AMPM").xlsm]", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
  End If
  Next cell
  Worksheets("SearchCasesResults").Activate
  ActiveWorkbook.Close

End Sub

1 个答案:

答案 0 :(得分:0)

您正在尝试保存到某个页面而不是文件夹。请尝试将saveas行更改为:

Application.SaveAs Filename:="//teamspace.merck.com/sites/emea_efpia/Shared%20Documents/EFPIA%20Regional%20Reporting%20Team%2FDispute%20Management/Dispute%20reports%20per%20market/Global%20Reporting/[FILENAME.xlsx]" _
 , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False