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

 

[jkpieterse]

Looks like there are no ContentTypeProperties with that name? Perhaps they have changed to English names? Not sure, I have never used these before.

 

[Kiron02]

Looks like there are no ContentTypeProperties with that name? Perhaps they have changed to English names? Not sure, I have never used these before.

I have tried with different names it didn't work...

 

[jkpieterse]

Click Debug when the error happens and select "ActiveWorkbook.ContentTypeProperties" and right-click it. Then choose "Add Watch". You can then click the tiny + next to the item in the watch pane to expand it and look at which items are available and how they are called.

 

[Kiron02]

Click Debug when the error happens and select "ActiveWorkbook.ContentTypeProperties" and right-click it. Then choose "Add Watch". You can then click the tiny + next to the item in the watch pane to expand it and look at which items are available and how they are called.

I don't have any +.

 

[jkpieterse]

Hmm. Not sure what to do next, sorry!

 

[Candyman8019]

it loos like you're using PSSTitle as part of the filename to save the workbook. You'll need to ensure the value of PSSTitle does not contain any characters that are invalid for a filename, such as * " / \ < > : | ?. So it is returning an error and jumping to "second_try"...which may or may not have the same restrictions.

 

[Kiron02]

it loos like you're using PSSTitle as part of the filename to save the workbook. You'll need to ensure the value of PSSTitle does not contain any characters that are invalid for a filename, such as * " / \ < > : | ?. So it is returning an error and jumping to "second_try"...which may or may not have the same restrictions.

I verify it juste before. The filename verify the requirements...

 

[Candyman8019]

Can you confirm the length of the path and filename do not exceed 255 characters?

 

[Kiron02]

Can you confirm the length of the path and filename do not exceed 255 characters?

Yes. it's depends of the title of the file but the filename is rarely longer than 100 characters.