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

 

[Kiron02]

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

When I delete the lines in red, yes

 

[Candyman8019]

Okay, put the red back in and remove this line:

On Error GoTo second_try

What error do you get now?

 

[Kiron02]

Okay, put the red back in and remove this line:

On Error GoTo second_try

What error do you get now?

Same error 91 on the same lines

 

[Candyman8019]

Can you share a screenshot of the sharepoint document properties page? I'm still feeling like the document isn't saving for some reason...

 

[Kiron02]

Are you talking about this page ? I clicked on "settings" button after clicking on the 3 dots of the folder where the files are saved on sharepoint. Because, if I click on "details" I get this following page:

 

[Candyman8019]

Okay, nothing there jumping out at me. Would your IT department prevent you from saving a .xlsm file for any reason? I know some don't like macro enabled documents and won't allow save. Are you able to manually upload that spreadsheet to the SharePoint?

 

[Kiron02]

Okay, nothing there jumping out at me. Would your IT department prevent you from saving a .xlsm file for any reason? I know some don't like macro enabled documents and won't allow save. Are you able to manually upload that spreadsheet to the SharePoint?

Yes I am. The problem seems really related to these variable in red, since others ones dont give an error. But on sharepoint, I don't understand what makes these variables, and not all of them, a problem... What do you think ?

 

[Candyman8019]

Okay, I did a bit of testing and was getting the same error you were. I was able to get these standard doc properties working using the BuiltInDocumentProperties. For example:

ActiveWorkbook.BuiltinDocumentProperties("Titre") = "My Document Title"

 

[Candyman8019]

Doing a little more digging...in addition to the BuiltinDocumentProperties, there are CustomDocumentProperties. And I noticed that the actual names of the properties aren't necessarily the same as they appear in SharePoint. You can list these properties with the following scripts.

Private Sub ShowProps()
rw = 1

'set sheet number to list properties on.
Sheet10.Activate
For Each p In ActiveWorkbook.CustomDocumentProperties
    Cells(rw, 1).Value = p.Name
    Cells(rw, 2).Value = p.Value
    rw = rw + 1
Next
End Sub

and

Private Sub ShowProps()
rw = 1

'set sheet number to list properties on.
Sheet10.Activate
For Each p In ActiveWorkbook.BuiltinDocumentProperties
    Cells(rw, 1).Value = p.Name
    Cells(rw, 2).Value = p.Value
    rw = rw + 1
Next
End Sub

 

[Kiron02]

I got this error

. I wrote it like that ActiveWorkbook.BuiltinDocumentProperties("Titre").Value = PSSTitle