vba om een pdf file opslaan op de One Drive

Question

wanneer ik op C: schijf de excel file gebruikt net onderstaande vba werkte goed echter wanneer ik de zefde excel file op One Drive open en dan het vba programma uitvoert gaat het fout. wat moet ik aanpassen zodat het ook op de One Drive werkt.

Sub KnopOpslaan()

    On Error GoTo ErrHandler:

        Dim FolderPath As String

        FolderPath = Application.ActiveWorkbook.path

        If Right(FolderPath, 1) <> "/" Then

            FolderPath = FolderPath & "/"

        End If

        Dim jaar As Integer

        jaar = Sheets("BasisInstellingen").Range("C5").Value

#If Mac Then

        FolderPath = CreateFolderinMacOffice2016(NameFolder:="Facturen" & jaar)

#Else

        FolderPath = FolderPath & "Facturen" & jaar

        If Dir(FolderPath, vbDirectory) = vbNullString Then

            MkDir FolderPath

        End If

#End If

        i = 1

        If isEmpty(Range("C18")) Then

            pdfname = "Factuur"

        Else

            pdfname = "Factuur " & Range("C18")

        End If

        If Dir(FolderPath & "/" & pdfname & ".pdf") <> "" Then

            Do While Dir(FolderPath & "/" & pdfname & ".pdf") <> ""

                If isEmpty(Range("C18")) Then

                    pdfname = "Factuur " & " (" & i & ")"

                Else

                    pdfname = "Factuur " & Range("C18") & " (" & i & ")"

                End If

                i = i + 1

                If i = 100 Then

                    Exit Do

                End If

            Loop

        End If

       With ActiveSheet.PageSetup

            .LeftMargin = Application.InchesToPoints(0.1)

            .RightMargin = Application.InchesToPoints(0.1)

            .TopMargin = Application.InchesToPoints(0.3)

            .BottomMargin = Application.InchesToPoints(0.1)

            .HeaderMargin = Application.InchesToPoints(0.1)

            .FooterMargin = Application.InchesToPoints(0.1)

            .CenterHorizontally = True

            .CenterVertically = False

        End With

        ActiveSheet.Range("B1:F47").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & "/" & pdfname & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

            :=False, OpenAfterPublish:=True

#If Mac Then

    If Range("M11").Cells(1, 1).Hyperlinks.Count = 0 Then

        Range("M11").Cells(1, 1).Hyperlinks.Add Range("M11").Cells(1, 1), "file:///" & FolderPath, "", "Open PDF folder", "Open PDF Folder"

        Range("M11").Font.Size = 14

        Range("M11").Font.Bold = True

        Range("M11").HorizontalAlignment = xlCenter

        Range("M11").VerticalAlignment = xlCenter

    End If

#End If

        Exit Sub

ErrHandler:

    MsgBox "Er is iets mis gegaan"

    Resume Next

End Sub

Function CreateFolderinMacOffice2016(NameFolder As String) As String

    'Function to create folder if it not exists in the Microsoft Office Folder

    'Ron de Bruin : 8-Jan-2016

    Dim OfficeFolder As String

    Dim PathToFolder As String

    Dim TestStr As String

    OfficeFolder = MacScript("return POSIX path of (path to desktop folder) as string")

    OfficeFolder = Replace(OfficeFolder, "/Desktop", "") & _

        "Library/Group Containers/UBF8T346G9.Office/"

    PathToFolder = OfficeFolder & NameFolder

    On Error Resume Next

    TestStr = Dir(PathToFolder, vbDirectory)

    On Error GoTo 0

    If TestStr = vbNullString Then

        MkDir PathToFolder

        'You can use this msgbox line for testing if you want

        'MsgBox "You find the new folder in this location :" & PathToFolder

    End If

    CreateFolderinMacOffice2016 = PathToFolder

End Function

Answer 1

ik heb de errhandler verwijderd en dat stop het programma op lijn 90, dus daar zit de fout.

Alleen hoe ik het moet oplossen zodat de file in de cloud van de onedrive wordt opgeslagen geen idee.

Answer 2

En is de executie van de code gestopt op lijn 500?

Answer 3

krijg de volgende meldingen

Debug.Print Err.Number

 0 

Debug.Print Err.Description

Debug.Print Erl

 0

Answer 4

Dag Joh56,

Ik heb niet direct een pasklaar antwoord maar kan wel enkele tips geven.

Maak een kopie van je code en sla die ergens op, vervang dan KnopOpslaandoor volgende code:

Sub KnopOpslaan()

10        On Error GoTo ErrHandler:

              Dim FolderPath As String

20            FolderPath = Application.ActiveWorkbook.Path

30            If Right(FolderPath, 1) <> "/" Then

40                FolderPath = FolderPath & "/"

50            End If

              Dim jaar As Integer

60            jaar = Sheets("BasisInstellingen").Range("C5").Value

#If Mac Then

70            FolderPath = CreateFolderinMacOffice2016(NameFolder:="Facturen" & jaar)

#Else

80            FolderPath = FolderPath & "Facturen" & jaar

90            If Dir(FolderPath, vbDirectory) = vbNullString Then

100               MkDir FolderPath

110           End If

#End If

120           i = 1

130           If IsEmpty(Range("C18")) Then

140               pdfname = "Factuur"

150           Else

160               pdfname = "Factuur " & Range("C18")

170           End If

180           If Dir(FolderPath & "/" & pdfname & ".pdf") <> "" Then

190               Do While Dir(FolderPath & "/" & pdfname & ".pdf") <> ""

200                   If IsEmpty(Range("C18")) Then

210                       pdfname = "Factuur " & " (" & i & ")"

220                   Else

230                       pdfname = "Factuur " & Range("C18") & " (" & i & ")"

240                   End If

250                   i = i + 1

260                   If i = 100 Then

270                       Exit Do

280                   End If

290               Loop

300           End If

310          With ActiveSheet.PageSetup

320               .LeftMargin = Application.InchesToPoints(0.1)

330               .RightMargin = Application.InchesToPoints(0.1)

340               .TopMargin = Application.InchesToPoints(0.3)

350               .BottomMargin = Application.InchesToPoints(0.1)

360               .HeaderMargin = Application.InchesToPoints(0.1)

370               .FooterMargin = Application.InchesToPoints(0.1)

380               .CenterHorizontally = True

390               .CenterVertically = False

400           End With

410           ActiveSheet.Range("B1:F47").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & "/" & pdfname & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

                  :=False, OpenAfterPublish:=True

#If Mac Then

420       If Range("M11").Cells(1, 1).Hyperlinks.Count = 0 Then

430           Range("M11").Cells(1, 1).Hyperlinks.Add Range("M11").Cells(1, 1), "file:///" & FolderPath, "", "Open PDF folder", "Open PDF Folder"

440           Range("M11").Font.Size = 14

450           Range("M11").Font.Bold = True

460           Range("M11").HorizontalAlignment = xlCenter

470           Range("M11").VerticalAlignment = xlCenter

480       End If

#End If

490           Exit Sub

ErrHandler:

500       MsgBox "Er is iets mis gegaan"

520       Resume Next

End Sub

De nummers zijn belangrijk in het diagnose proces.

Set een breekpunt op lijn 500 (F9)

Run de code, waarschijnlijk zal ze op lijn 500 stoppen.

In het immediate window:

Debug.Print Err.Number

Debug.Print Err.Description

Debug.Print Erl

Dit laatste geeft het lijnnummer waar de fout is opgetreden. Dit zou je al een pak verder moeten helpen.

Answer 5

Beste joh56(2),

Bedankt voor je bericht!

Echter ondersteunen wij op dit forum niet dit soort technische ondersteuning.

Ik kan je verwijzen naarMicrosoft TechNet Forums, waar je zeker geholpen kan worden! Er kan hier natuurlijk wel een community lid je helpen. 

Ik hoop dat je probleem opgelost kan worden

Met vriendelijke groet,

Balthazar