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]

rather than BuiltInDocumentProperties, this second script references CustomDocumentProperties

Ignore my last message...
When I use this code

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

I get this

And when I use this

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

I get this:

 

[Candyman8019]

Okay, so Title is part of the builtindocumentproperties; however, the field label appears to be in English...so try this line then...

ActiveWorkbook.BuiltinDocumentProperties("Title").Value = PSSTitle

 

[Kiron02]

Okay, so Title is part of the builtindocumentproperties; however, the field label appears to be in English...so try this line then...

ActiveWorkbook.BuiltinDocumentProperties("Title").Value = PSSTitle

It works ! But now I got the error 91 on the line : ActiveWorkbook.ContentTypeProperties("Statut").Value = "Define"

 

[Candyman8019]

I can't see Statut or Status in either of the property screenshots you sent. Can you check in the ContentTypeProperties with this script.

Private Sub ShowProps()
rw = 1

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

 

[Kiron02]

I can't see Statut or Status in either of the property screenshots you sent. Can you check in the ContentTypeProperties with this script.

Private Sub ShowProps()
rw = 1

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

I got this.

 

[Candyman8019]

I still don't see Statut in any of the properties screenshots. If you do see that field when you go into sharepoint properties then let's try this.
1. Save a .xlsm file to sharepoint manually.
2. In SharePoint, update the Statut property with a specific value.
3. Open the spreadsheet and run each of the three DocProp scripts and find out which field was actually populated with the value you entered.

 

[Kiron02]

I still don't see Statut in any of the properties screenshots. If you do see that field when you go into sharepoint properties then let's try this.
1. Save a .xlsm file to sharepoint manually.
2. In SharePoint, update the Statut property with a specific value.
3. Open the spreadsheet and run each of the three DocProp scripts and find out which field was actually populated with the value you entered.

By default the files got the value "define" in the "Statut" column

 

[Kiron02]

I still don't see Statut in any of the properties screenshots. If you do see that field when you go into sharepoint properties then let's try this.
1. Save a .xlsm file to sharepoint manually.
2. In SharePoint, update the Statut property with a specific value.
3. Open the spreadsheet and run each of the three DocProp scripts and find out which field was actually populated with the value you entered.

But here I get this Statut Property:

Using this code :

Private Sub ShowProps()
rw = 1

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

 

[Candyman8019]

Okay good...so it is in the ContentTypeProperties.

OH!

Try removing the .value like this...

ActiveWorkbook.ContentTypeProperties("Statut") = "Define"

 

[Kiron02]

Okay good...so it is in the ContentTypeProperties.

OH!

Try removing the .value like this...

ActiveWorkbook.ContentTypeProperties("Statut") = "Define"

Same error 91