我创建了一个应该刷新所有数据源的宏。它的数据源是sql server,因此会根据需要自动提取密码框。如果您自上次打开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)运行数据刷新(来自Here)
3)保存到\\Company.local\AnyDrive\Company\Projects\Project001\Reporting\Report Updates
(假名,实际结构),文件名为FileName
08/07/2015(其中FileName
是文件的当前名称)< / p>
有关原因的任何线索?
编辑:
根据评论,它没有按照我的要求保存文件。
==================
我已经修改了代码但它仍然无法正常工作。由于添加了“删除工作表”步骤,因为循环导致重复删除其中一个工作表,所以我已经移动了一些东西。
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
答案 0 :(得分: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
答案 1 :(得分:1)
您不能在Windows文件名中包含斜杠。您在Format
函数中缺少语音标记。更改此代码:
StrSaveName = "Report" & Format(Date, ddmmyyyy) & ".xlsx"
要:
StrSaveName = "Report" & Format(Date, "ddmmyyyy") & ".xlsx"
将日期设为08072015。
答案 2 :(得分:0)
行。感谢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