更新工作簿并使用VBA保存

Question

I've created a macro which should refresh all data sources. It's data sources are sql servers, and as such automatically pull up the password box as required. If you've already input a password into the server since Excel was last opened it doesn't ask for the password.

I've managed to get the following piece of code together, but it's not behaving as I'd expect

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

From my knowledge of VBA this should do the following:

1) Clear all filters from the tables

2) Run a data refresh (cribbed from Here )

3) Save to \\\\Company.local\\AnyDrive\\Company\\Projects\\Project001\\Reporting\\Report Updates (fake names, actual structure) with the file name as FileName 08/07/2015 (where FileName is the current name of the file)

Any clues as to why this is?

EDIT:

As per comments, its not saving the documents as I require.

==================

I've altered the code and it's still not working. I've moved things around as the loop was leading to repeated deletion of one of the sheets due to the addition of a "delete sheet" step.

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

My issue is that it doesn't seem to save to where it needs to be :S

Answer 1

ActiveWorkbook.Path & "\\Company.local

Double "\\" sign is your problem. Cut one of those and you should be fine (or at least you'll move to some other problem if it turns out there is one later).

Also, calling your project Project-001 will bite you once you have several projects and you can't remember which number is doing what. Best to start giving proper descriptive names right at the start.

---

Edit: You don't specify file format in your SaveAs - this may cause problems. Will such code help?

Sub TestSave()

    Dim savepath As String

    savepath = ThisWorkbook.Path & "\\testdir\" & "test.xlsm"

    ThisWorkbook.SaveAs Filename:=savepath, FileFormat:=52

End Sub

51 is xlsx, 52 is xlsm, 56 is xls

Answer 2

You cannot include slashes in Windows file names. You are missing speech marks in the Format function. Change this code:

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

To:

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

to get the date as 08072015.

Answer 3

OK. Thanks to Jacek and Chips I've managed to trouble shoot this VBA.

Seems that I'd formatted the "save as" data wrongly. Below is the working Macro, in case anyone else comes across the issue :)

Next step is for me to do a show/hide so the only thing that shows on entry to the workbook is the spreadsheet update page. I'll post the code for this later as an additional comment.

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