VBA Excel, Error code 91

[Kiron02]

Hello, I was using this macro for a form and one day, it stopped to work and I got the error 91

The thing I don't understand, i have this error only for lines in bold and red.
Does someone have a solution for this please ?

Thank you !



Sub Save_SharePoint_A_Initiation()


Dim Leader As String
Leader = ActiveWorkbook.Worksheets("A3_PSS").Range("C5").Value

Dim TeamLeader As String
TeamLeader = ActiveWorkbook.Worksheets("A3_PSS").Range("G6").Value

Dim DptLeader As String
DptLeader = ActiveWorkbook.Worksheets("A3_PSS").Range("C6").Value

Dim CreationDate As String
CreationDate = ActiveWorkbook.Worksheets("A3_PSS").Range("S6").Value

Dim PSSTitle As String
PSSTitle = ActiveWorkbook.Worksheets("A3_PSS").Range("C7").Value


Dim Coach As String
Coach = ActiveWorkbook.Worksheets("A3_PSS").Range("U5").Value

Dim Keywords As String
Keywords = ActiveWorkbook.Worksheets("A3_PSS").Range("S8").Value



Dim Titre As String
Titre = ActiveWorkbook.Worksheets("A3_PSS").Range("C8").Value

If InStr(1, Titre, "*") > 0 Or InStr(1, Titre, "?") Or InStr(1, Titre, "!") Or InStr(1, Titre, "~") Or InStr(1, Titre, "$") Then
VBA.Interaction.MsgBox "Bonjour " & Excel.Application.UserName & "," & vbCrLf & "Veuillez inscrire un titre sans caractères spéciaux ( * ; ! ; ? ; ~ ; $ ; etc )", , "Message d'erreur"
End
End If


Range("C8:P8").Copy
Range("C7").PasteSpecial (xlPasteAll)
Application.CutCopyMode = False
PSSTitle = ActiveWorkbook.Worksheets("A3_PSS").Range("C8").Value


If Leader = "Prénom Nom" Or Leader = "" Then
VBA.Interaction.MsgBox "Bonjour " & Excel.Application.UserName & "," & vbCrLf & "Merci d'indiquer le nom du leader du PSS avant de l'enregistrer (cellule B5).", , "Informations obligatoires"
End
End If


If TeamLeader = "Sélectionne ton équipe" Or TeamLeader = "" Then
VBA.Interaction.MsgBox "Bonjour " & Excel.Application.UserName & "," & vbCrLf & "Merci d'indiquer l'équipe du Leader du PSS avant de l'enregistrer (cellule E6).", , "Informations obligatoires"
End
End If

If DptLeader = "Sélectionne ton département" Or DptLeader = "" Then
VBA.Interaction.MsgBox "Bonjour " & Excel.Application.UserName & "," & vbCrLf & "Merci d'indiquer le departement du Leader du PSS avant de l'enregistrer (cellule B6).", , "Informations obligatoires"
End
End If

If CreationDate = "jj.mm.aaaa" Or CreationDate = "" Then
VBA.Interaction.MsgBox "Bonjour " & Excel.Application.UserName & "," & vbCrLf & "Merci d'indiquer la date du PSS avant de l'enregistrer (cellule Q6).", , "Informations obligatoires"
End
End If

If PSSTitle = "" Then
VBA.Interaction.MsgBox "Bonjour " & Excel.Application.UserName & "," & vbCrLf & "Merci d'indiquer le titre du PSS avant de l'enregistrer (cellule B7).", , "Informations obligatoires"
End
End If


On Error GoTo second_try
ActiveWorkbook.SaveAs Filename:= _
"https://mdigital.sharepoint.com/xxxxxxxxx " & PSSTitle & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

second_try:
ActiveWorkbook.ContentTypeProperties("Titre").Value = PSSTitle
ActiveWorkbook.ContentTypeProperties("Leader").Value = Leader
ActiveWorkbook.ContentTypeProperties("Team du Leader").Value = TeamLeader
ActiveWorkbook.ContentTypeProperties("Departement du Leader").Value = DptLeader
ActiveWorkbook.ContentTypeProperties("Creation date").Value = CDate(CreationDate)
ActiveWorkbook.ContentTypeProperties("Statut").Value = "Define"
ActiveWorkbook.ContentTypeProperties("Coach").Value = Coach
ActiveWorkbook.ContentTypeProperties("Keywords").Value = Keywords
ActiveWorkbook.SaveAs Filename:= _
"https://mdigital.sharepoint.com/xxxxxxx " & PSSTitle & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

VBA.Interaction.MsgBox "Bonjour " & Excel.Application.UserName & "," & vbCrLf & "Votre PSS a bien été enregistré et est maintenant en statut Define!" & vbCrLf & vbCrLf & "Vous pouvez le continuer et le consulter en allant sur VeveyPlace, dans l'onglet Problem Solving puis 'Consulter un Problem Solving'" & vbCrLf & vbCrLf & "Une fenêtre va s'ouvir automatiquement pour vous permettre d'inviter par mail les participants à rejoindre la première réunion PSS.", , "Sauvegarde et status"



Set olOutlook = CreateObject("Outlook.Application")
Set Namespace = olOutlook.GetNameSpace("MAPI")
Set oloFolder = Namespace.GetDefaultFolder(9)
Dim Jour As Variant
Jour = Date + 31


Description = "Invitation au PSS - " & PSSTitle
StartDate = Jour & " 11:00" 'Mettre date de debut
EndDate = Jour & " 11:45" 'Mettre date de fin

LienPSS = "https://mdigital.sharepoint.com/xxxxxxxx"
Corps_Text = "Hello Problem Solver," & vbCrLf & vbCrLf & "Je t'invite à participer au PSS au sujet de : " & PSSTitle & vbCrLf & vbCrLf & "Tu retrouveras le template de ce PSS ici : " & LienPSS & vbCrLf & vbCrLf & "Merci d'avance pour ta participation, n'hésite pas à me contacter si tu as des questions d'ici là." & vbCrLf & vbCrLf & "Bonne journée," & vbCrLf & vbCrLf & "Cordialement"


Set Appointment = oloFolder.items.Add

With Appointment
.Start = StartDate
.End = EndDate
.Subject = Description
.Body = Corps_Text
.SendUsingAccount = CompteOutlook
.Display
.MeetingStatus = 1 'pour afficher la section "inviter" et permettre la fonction send

End With

End Sub

 

[Candyman8019]

For those properties you marked in red...can you confirm that those property fields exist in the doc already? This post states that you cannot "create the property fields with VBA" Setting Custom Document properties that will be used in Sharepoint

 

[Kiron02]

For those properties you marked in red...can you confirm that those property fields exist in the doc already? This post states that you cannot "create the property fields with VBA" Setting Custom Document properties that will be used in Sharepoint

Yes they do. The origin of the problem seems to be the sharepoint settings..

 

[Candyman8019]

Can you try manually checking out the document in SharePoint then see if your script runs?

 

[Kiron02]

Can you try manually checking out the document in SharePoint then see if your script runs?

Actually, this error makes the upload of my file from excel to sharepoint be impossible ...

 

[Candyman8019]

So you're saying that the following code isn't actually saving the doc in SharePoint?

ActiveWorkbook.SaveAs Filename:= _
"[URL]https://mdigital.sharepoint.com/xxxxxxxxx[/URL] " & PSSTitle & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

If so, that's the problem. I'm pretty sure the doc needs to be saved to SharePoint before those properties are added.

For saving to SharePoint, can you confirm that your actual code has a / at the end of the path...and no spaces after, for example: "https://mdigital.sharepoint.com/xxxxxxxxx/"

 

[Kiron02]

So you're saying that the following code isn't actually saving the doc in SharePoint?

ActiveWorkbook.SaveAs Filename:= _
"[URL]https://mdigital.sharepoint.com/xxxxxxxxx[/URL] " & PSSTitle & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

If so, that's the problem. I'm pretty sure the doc needs to be saved to SharePoint before those properties are added.

For saving to SharePoint, can you confirm that your actual code has a / at the end of the path...and no spaces after, for example: "https://mdigital.sharepoint.com/xxxxxxxxx/"

No, it doesn't have /, there is a space in fact

 

[Kiron02]

So you're saying that the following code isn't actually saving the doc in SharePoint?

ActiveWorkbook.SaveAs Filename:= _
"[URL]https://mdigital.sharepoint.com/xxxxxxxxx[/URL] " & PSSTitle & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

If so, that's the problem. I'm pretty sure the doc needs to be saved to SharePoint before those properties are added.

For saving to SharePoint, can you confirm that your actual code has a / at the end of the path...and no spaces after, for example: "https://mdigital.sharepoint.com/xxxxxxxxx/"

But I think the problem is not this because when I delete the lines I colored in red, it works, because the error message is on these lines.
So the goal is to understand these lines make an error, then we will be able to correct it.

 

[Candyman8019]

I'm thinking the file isn't actually saving because the path needs to end with a / rather than a space. The / will tell it where the path ends and the filename begins. Once the file is saved, SharePoint should add those additional properties, then those lines marked in red should work just fine.

 

[Kiron02]

I'm thinking the file isn't actually saving because the path needs to end with a / rather than a space. The / will tell it where the path ends and the filename begins. Once the file is saved, SharePoint should add those additional properties, then those lines marked in red should work just fine.

I change the path by adding the /, but I encountered the same error code 91
On Error GoTo second_try
ActiveWorkbook.SaveAs Filename:= _
"https://mdigital.sharepoint.com/xxx/xxx/xxx/xxxx/" & "PSS - " & PSSTitle & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

 

[Candyman8019]

Can you confirm the file is actually saving to SharePoint? Not necessarily checked-in...but at least saving.