更新工作簿並使用VBA保存

Question

我創建了一個應刷新所有數據源的宏。 它的數據源是sql服務器，因此會根據需要自動拉出密碼框。 如果自從上次打開Excel后已經在服務器中輸入了密碼，則不會要求輸入密碼。

我設法將下面的代碼放在一起，但是卻表現不佳

Sub BSR_Refresher()
'Refreshes the spreadsheet and copies it with today's date

'Clears all filters

On Error Resume Next
ActiveWorkbook.ShowAllData


'Refreshes Spreadsheet

  For Each objConnection In ThisWorkbook.Connections
    'Get current background-refresh value
    bBackground = objConnection.OLEDBConnection.BackgroundQuery

    'Temporarily disable background-refresh
    objConnection.OLEDBConnection.BackgroundQuery = False

    'Refresh this connection
    objConnection.Refresh

    'Set background-refresh value back to original value
    objConnection.OLEDBConnection.BackgroundQuery = bBackground
   Next

'Saves Spreadsheet

ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\\Company.local\AnyDrive\Company\Projects\Project001\Reporting\Report Updates" & Format(Date, ddmmyyyy) & ".xls"
      End Sub

據我對VBA的了解，這應該執行以下操作：

1）清除表格中的所有過濾器

2）運行數據刷新（從此處開始 ）

3）保存到\\\\Company.local\\AnyDrive\\Company\\Projects\\Project001\\Reporting\\Report Updates （假名，實際結構），文件名為FileName 08/07/2015（其中FileName是文件的當前名稱） ）

關於這為什么的任何線索？

編輯：

根據評論，它沒有按我的要求保存文件。

==================

我已經更改了代碼，但仍然無法正常工作。 由於循環導致由於添加了“刪除工作表”步驟而導致重復刪除工作表之一，因此我進行了一些改動。

Sub BSR_Refresher()
'Refreshes the spreadsheet and copies it with today's date

' Gets name to save new workbook as
  Dim StrSaveName As String
    Dim StrFolderPath As String
    StrSaveName = "Report" & Format(Date, ddmmyyyy) & ".xlsx"
    StrFolderPath = "\\Company.local\anyDrive\Company\Projects\Project-001\Reporting\Status Report Updates\"
    StrSaveAs = StrFolderPath & StrSaveName
'Deletes Sheet1, Clears all filters

Application.DisplayAlerts = False

    Sheets("Sheet1").Select
     ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = True

'Refreshes Spreadsheet
On Error Resume Next
ActiveWorkbook.ShowAllData

   For Each objConnection In ThisWorkbook.Connections
        'Get current background-refresh value
        bBackground = objConnection.OLEDBConnection.BackgroundQuery

        'Temporarily disable background-refresh
        objConnection.OLEDBConnection.BackgroundQuery = False

        'Refresh this connection
        objConnection.Refresh

        'Set background-refresh value back to original value
        objConnection.OLEDBConnection.BackgroundQuery = bBackground
Next

'Saves Spreadsheet

 ActiveWorkbook.SaveAs Filename:=StrSaveAs


End Sub

我的問題是它似乎沒有保存到需要的位置：S

Answer 1

ActiveWorkbook.Path & "\\Company.local

雙“ \\”符號是您的問題。 剪掉其中之一，你應該沒事（或者，如果后來發現有至少一個，至少您會遇到其他問題）。

此外，一旦您有多個項目，就稱您的項目Project-001將咬您，並且您不記得哪個號碼在做什么。 最好從一開始就開始提供適當的描述性名稱。

---

編輯：您未在SaveAs指定文件格式-這可能會導致問題。 這樣的代碼會有所幫助嗎？

Sub TestSave()

    Dim savepath As String

    savepath = ThisWorkbook.Path & "\\testdir\" & "test.xlsm"

    ThisWorkbook.SaveAs Filename:=savepath, FileFormat:=52

End Sub

51是xlsx，52是xlsm，56是xls

Answer 2

Windows文件名中不能包含斜杠。 您在Format功能中缺少語音標記。 更改此代碼：

    StrSaveName = "Report" & Format(Date, ddmmyyyy) & ".xlsx"

至：

    StrSaveName = "Report" & Format(Date, "ddmmyyyy") & ".xlsx"

獲取日期為08072015。

Answer 3

好。 多虧了Jacek和Chips，我才得以解決這個VBA的麻煩。

似乎我錯誤地格式化了“另存為”數據。 下面是工作中的宏，以防其他任何人遇到問題:)

下一步是讓我進行顯示/隱藏，因此在輸入工作簿時唯一顯示的是電子表格更新頁面。 我將在稍后發布此代碼作為附加注釋。

Sub Spreadsheet_Refresher()

'Refreshes the spreadsheet and copies it with today's date

' Gets name to save new workbook as
  Dim StrSaveName As String
  Dim StrFolderPath As String
 StrSaveName = "Report" & " " & Format(Date, "dd-mm-yyyy") & ".xlsm"
    StrFolderPath = "\\Company.local\AnyDrive\Company\Projects\001\Reporting\Status Report Updates\"
    StrSaveAs = StrFolderPath & StrSaveName

'Deletes Update Spreadsheet worksheet

Application.DisplayAlerts = False

    Sheets("Update Spreadsheet").Select
     ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = True

'Refreshes Spreadsheet

  For Each objConnection In ThisWorkbook.Connections
    'Get current background-refresh value
    bBackground = objConnection.OLEDBConnection.BackgroundQuery

    'Temporarily disable background-refresh
    objConnection.OLEDBConnection.BackgroundQuery = False

    'Refresh this connection
    objConnection.Refresh

    'Set background-refresh value back to original value
    objConnection.OLEDBConnection.BackgroundQuery = bBackground
   Next




'Saves Spreadsheet

 ActiveWorkbook.SaveAs Filename:=StrSaveAs


End Sub