Question

我创建了一个应该刷新所有数据源的宏。它的数据源是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

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

更新工作簿并使用VBA保存

3 个答案: