Файл не сохраняется на Sharepoint без каких-либо ошибок. Только пошагово сохраняет файл - PullRequest
0 голосов
/ 15 февраля 2020

У меня странная проблема с моим кодом. Вчера это сработало, но сегодня макрос работает вроде бы нормально, но файл не сохраняется на Sharepoint. Я не получаю ошибок.

Когда я перехожу через код, он сохраняет его. Что я заметил, так это то, что при автоматическом запуске макроса я получаю только что-то вроде «Загрузка списка контента Sharepoint» - я перевожу его.

Но при переходе я получаю второе окно с надписью «Сохранение файла».

Вот мой код:

Private Sub Workbook_Open()

On Error GoTo RefreshHandler

    RefreshPQConnections
    ActiveWorkbook.RefreshAll

If Format(Date, "dd.mm.yyyy") = Sheets("chart").Range("T2").Value Then

Sheets("chart").Range("Y2:Y3").ClearContents

Else

End If


    Sheets("toggl_report").Activate

        If Format(ActiveSheet.Range("A2").Value, "dd.mm.yyyy") <> Format(Date, "dd.mm.yyyy") Then
            ElseIf ActiveSheet.Range("A2") = "" Then
            MsgBox ("Old data or no data")
        Else

        Dim NextRow As Long
        NextRow = Sheets("data_ongoing").Range("A1").End(xlDown).Row + 1


        Sheets("toggl_report").Range("B2:M2").Select
        Sheets("toggl_report").Range(Selection, Selection.End(xlDown)).Copy
        Sheets("data_ongoing").Range("A" & NextRow).PasteSpecial xlPasteValues

        Sheets("data_ongoing").Activate
        ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort. _
        SortFields.Clear
        ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort. _
        SortFields.Add2 Key:=Range("toggl_table[updated]"), SortOn:=xlSortOnValues, _
        Order:=xlDescending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        ActiveSheet.ListObjects("toggl_table").Range.RemoveDuplicates Columns:=Array(1), Header:=xlYes

        ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort. _
        SortFields.Add2 Key:=Range("toggl_table[start]"), SortOn:=xlSortOnValues, _
        Order:=xlDescending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("data_ongoing").ListObjects("toggl_table").Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        ActiveWorkbook.RefreshAll

            Dim FindNo As Range

            Sheets("blacklist").Activate

            Dim BlacklistRange As Range
            Set BlacklistRange = Range("blacklist[sent_by_email]")

            Set FindNo = BlacklistRange.Find(What:="", After:=Cells(2, 11), LookIn:=xlValues, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False)

            If Not FindNo Is Nothing Then

                ActiveSheet.ListObjects("blacklist").Range.AutoFilter Field:=11, Criteria1:= _
                ""

                ActiveSheet.Range(Range("B1:J1"), Range("B1:J1").End(xlDown)).Select

                Mail_Selection_Range_Outlook_Body

                Sheets("blacklist").Activate
                ThisWorkbook.Worksheets("blacklist").ShowAllData

                For x = 2 To Range("I1").End(xlDown).Row
                    If Cells(x, 11).Value = "Yes" Then
                    Else
                    Cells(x, 11).Value = "Yes"
                    End If
                Next

            Else

            End If

        End If

        Dim CurrentMonth As String
        CurrentMonth = WorksheetFunction.Text(Date, "[$-409]mmm")

        Sheets("chart").PivotTables("Tabela przestawna17").PivotFields("month"). _
        CurrentPage = CurrentMonth

        Call CheckThresholds

        ThisWorkbook.RefreshAll

        ThisWorkbook.Save

        Workbooks.Open ("C:\Users\208896\Desktop\Moje Makra\toggl_live.xlsx")
        Workbooks("toggl_live").Activate

        Workbooks("toggl_live").RefreshAll
        Workbooks("toggl_live").Save
        Workbooks("toggl_live").SaveAs Filename:= _
        "https://ingrammicro.sharepoint.com/sites/OG-BIGoleniowWorkspace/Shared%20Documents/Toggl%20Live/toggl_live.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Workbooks("toggl_live").Close True

        ThisWorkbook.Save

Application.Quit

Exit Sub

RefreshHandler:
MsgBox ("Refresh unsucessful or other unidentified error")


End Sub
...