更新工作簿并使用VBA进行保存

我创build了一个应该刷新所有数据源的macros。 它的数据源是sql服务器，并根据需要自动提取密码框。 如果您从上次打开Excel以来已经向服务器input密码，则不会要求input密码。

我已经设法得到了下面的一段代码，但它不像我所期望的那样

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）清除表格中的所有filter

2）运行一个数据刷新（从这里 cri手）脚）

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 

双“\”标志是你的问题。 把其中的一个切掉，你应该没问题（或者至less如果事后有一个问题的话，你会转向其他的问题）。

另外，一旦你有几个项目，调用你的项目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文件名中包含斜杠。 Formatfunction中缺less语音标记。 更改此代码：

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

至：

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

得到date为08072015。

Answer 3

好。 由于Jacek和芯片，我设法麻烦拍摄这个VBA。

似乎错误地格式化了“另存为”数据。 下面是工作的macros，以防其他人遇到问题:)

下一步是我做一个显示/隐藏，所以显示在工作簿上的唯一东西就是电子表格更新页面。 我将在稍后发布代码作为附加评论。

 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