Сохранение с именем в ячейке с удалением кавычек - VBA

Dim WA As Object, WD As Object
sDirname = Application.ThisWorkbook.Path & "\" & CStr(Year(Date)) & "\" & CStr(Format(Now, "mm")) & "\" & Replace([B11], Chr(34), " ")
MkDir (Application.ThisWorkbook.Path & "\" & CStr(Year(Date)))
MkDir (Application.ThisWorkbook.Path & "\" & CStr(Year(Date)) & "\" & CStr(Format(Now, "mm")))
MkDir (Application.ThisWorkbook.Path & "\" & CStr(Year(Date)) & "\" & CStr(Format(Now, "mm")) & "\" & Replace([B11], Chr(34), " "))
Application.DisplayAlerts = False
ChDrive Left(sDirname, 1): ChDir "Application.ThisWorkbook.Path" & CStr(Year(Date)) & "\" & CStr(Format(Now, "mm")) & "\" & Replace([B11], Chr(34), " ")
Set WA = CreateObject("Word.Application")
Set WD = WA.Documents.Open(Application.ThisWorkbook.Path & "\protos.doc")
Set WS = WA.Documents.Open(Application.ThisWorkbook.Path & "\svid.doc")
 
WA.Visible = True
WD.Visible = True
WS.Visible = True
 
WD.ChangeFileOpenDirectory ThisWorkbook.Path & "\" & CStr(Year(Date)) & "" & CStr(Format(Now, "mm")) & "\" & Replace([B11], Chr(34), " ")
WD.SaveAs Filename:=ThisWorkbook.Path & "\" & CStr(Year(Date)) & "\" & CStr(Format(Now, "mm")) & "\" & Replace([B11], Chr(34), " ") & "\" & Range("B3") & "p.doc", _
FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
 
WS.ChangeFileOpenDirectory ThisWorkbook.Path & "\" & CStr(Year(Date)) & "\" & CStr(Format(Now, "mm")) & "\" & Replace([B11], Chr(34), " ")
WS.SaveAs Filename:=ThisWorkbook.Path & "\" & CStr(Year(Date)) & "\" & CStr(Format(Now, "mm")) & "\" & Replace([B11], Chr(34), " ") & "\" & Range("B3") & ".doc", _
FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
 
Set WA = Nothing

Function Replace_symbols(ByVal txt As String) As String 'убираем запрещённые в именах файлов символы! И пробелы и слэши тоже в данном случае!
    Dim st$, i&
    st$ = "\/<>?^*: |`'"""
    For i& = 1 To Len(st$)
        txt = Replace(txt, Mid(st$, i, 1), "_")
    Next
    Replace_symbols = txt
End Function