更新工作簿并使用VBA保存

时间:2015-07-08 11:02:43

标签: excel vba excel-vba

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

3 个答案:

答案 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