Bonjour à tous,
Je ne sais pas si je suis au bon endroit mais comme mon problème est sur Excel alors je me lance.
J'ai une macro qui permet d'imprimer en PDF l'onglet "Navette" et aussi qui teste la présence de dossier et sous-dossier, et qui les crée s'ils n'existent pas. Cela fonctionne bien ave une adresse OneDrive en local, pour des raisons de duplication de fichiers j'aimerais qu'elle fonctionne avec sharepoint, voici le code:
et j'ai une erreur ici: Set dossier = fso.GetFolder(repertoire)
qui me dit que le chemin est introuvable.
J'ai cherché une solution , j'ai trouvé des choses mais rien ne va et je ne suis pas assez calé pour régler ce problème.
Si vous avez une idée ça serait un beau cadeau de NOEL
Je ne sais pas si je suis au bon endroit mais comme mon problème est sur Excel alors je me lance.
J'ai une macro qui permet d'imprimer en PDF l'onglet "Navette" et aussi qui teste la présence de dossier et sous-dossier, et qui les crée s'ils n'existent pas. Cela fonctionne bien ave une adresse OneDrive en local, pour des raisons de duplication de fichiers j'aimerais qu'elle fonctionne avec sharepoint, voici le code:
VB:
Function testDossier(repertoire As String, dossierTeste As String) As Boolean
testDossier = False
Dim fso, dossier, sousDossiers As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set dossier = fso.GetFolder(repertoire)
'vérification des sous dossiers
For Each sousDossiers In dossier.subFolders
If repertoire & dossierTeste = sousDossiers Then
testDossier = True
Exit For
End If
Next
End Function
Sub Archive_Fiche_Navette()
Dim repertoireBase As String
Set xShell = CreateObject("WScript.Shell")
repertoireBase = "C:\Users\Utilisateur\OneDrive - xxxxxxxxxx\Administration des Ventes\NAVETTE" & "\"
'https://xxxxxxxxxxmy.sharepoint.com/personal/xxxxxxxxxx/_layouts/15/onedrive.aspx?id=%2FShared%20Documents%2FAdministration%20des%20Ventes&listurl=https%3A%2F%2Fsfr1008375%2Esharepoint%2Ecom%2FShared%20Documents&view=0
Dim dossierDate As String
dossierDate = Year(Date)
Dim repertoireDossierDate As String
repertoireDossierDate = repertoireBase & dossierDate
If testDossier(repertoireBase, dossierDate) = False Then
MkDir repertoireDossierDate
End If
Dim dossierInit As String
dossierInit = Worksheets("données").Range("ab2")
Dim repertoireDossierInit As String
repertoireDossierInit = repertoireDossierDate & "\" & dossierInit
If testDossier(repertoireDossierDate & "\", dossierInit) = False Then
MkDir repertoireDossierInit
End If
Dim nomFichier As String
nomFichier = Sheets("Navette").Range("a2") & " " & Sheets("Navette").Range("c9") & " Commande du " & Format(Sheets("Navette").Range("c3"), " dd mm yyyy") & ".pdf"
Dim repertoireFichierPDF As String
repertoireFichierPDF = repertoireDossierInit & "\" & nomFichier & ".pdf"
Worksheets("NAVETTE").ExportAsFixedFormat Type:=xlTypePDF, Filename:=repertoireFichierPDF
Effacer_Navette
End Subet j'ai une erreur ici: Set dossier = fso.GetFolder(repertoire)
qui me dit que le chemin est introuvable.
J'ai cherché une solution , j'ai trouvé des choses mais rien ne va et je ne suis pas assez calé pour régler ce problème.
Si vous avez une idée ça serait un beau cadeau de NOEL
