更新工作簿并使用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