Использование Access VBA для замены строки в слове создает лишнее пространство в начале абзаца
У меня есть доступ к таблице, в которой содержатся параграфы для писем клиентам. У каждой буквы есть несколько абзацев.
На нашем сервере есть шаблон документа.
Я использую приведенный ниже код для вставки (в 240-символьных пакетах, потому что все, что больше, генерирует сообщение об ошибке "слишком много символов")
Все работает нормально, за исключением того, что кроме первой строки каждого абзаца каждая строка имеет отступ в виде пробела.
Я воссоздал слово шаблон. Я проверил параграфы и выравнивание в слове. Здесь также нет табуляции.
Я использую Windows 10, Office 2010, Access 2010 интерфейс, сервер SQL Server
Один абзац слишком большой и разделен на 2, но при переносе точка соединения (в середине слова) выглядит нормально.
Код
'3. Build letter text
sPara1 = DLookup("CorroParagraphText", "t_CorroParagraph", "([CPCorroTemplateid] = " & iCorroTemplate & ") and ([CorroParagraphNumber] = " & iPara & ")")
iPara = iPara + 1
sPara2 = DLookup("CorroParagraphText", "t_CorroParagraph", "([CPCorroTemplateid] = " & iCorroTemplate & ") and ([CorroParagraphNumber] = " & iPara & ")")
iPara = iPara + 1
sPara3 = DLookup("CorroParagraphText", "t_CorroParagraph", "([CPCorroTemplateid] = " & iCorroTemplate & ") and ([CorroParagraphNumber] = " & iPara & ")")
'3a. replace strings where needed
sPara1 = replace(sPara1, "[Address]", sSendTo)
sPara1 = replace(sPara1, "[Date]", Format(date, "dd/mm/yyyy"))
'20180117 MO - using alot of Dlookups for practice!
sName = Nz(DLookup("PersTitle", "t_Person", "PersonId = " & iMainPOCPersonId), "")
sName = sName & " " & Nz(DLookup("PersSurname", "t_Person", "PersonId = " & iMainPOCPersonId), "")
sPara1 = replace(sPara1, "[Name]", sName & ",")
sPara1 = replace(sPara1, "[FEC ID]", iFECRef)
sLeadName = DLookup("StaffName", "Staff", "[ID] =" & iLeadStaffId)
sLeadName = sLeadName & " " & DLookup("StaffSurname", "Staff", "[ID] =" & iLeadStaffId)
sLeadJobTitle = DLookup("JobTitle", "Staff", "[ID] =" & iLeadStaffId)
sLeadEmail = DLookup("StaffEmail", "Staff", "[ID] =" & iLeadStaffId)
sLeadStaff = sLeadName & vbCrLf & sLeadJobTitle & vbCrLf & sLeadEmail
sPara3 = replace(sPara3, "[LeadStaff]", sLeadStaff)
strCorroAttach = DLookup("CTAAttachment", "t_CorroTemplateAttachment", "[CTACorroTemplateID] = " & iCorroTemplate)
sContent = sPara1 & vbCrLf & sPara2 & vbCrLf & sPara3
'4. PDF and save letter in customer folder with copy of complaint procedure
'this is where the draft leter will be saved.
DirName = "P:\General Enquiries\Customer_Files\ID " & Format(iFECRef, "0000")
DirContracts = DirName & "\Contracts"
DirOther = DirName & "\Other Info"
DirRenewables = DirName & "\Renewables"
'create the directory if it doesn't exist
If Dir(DirName, vbDirectory) = "" Then
MkDir DirName
MkDir DirContracts
MkDir DirOther
MkDir DirRenewables
End If
'this is the template that is used to create the letter
strWordTemplate = "P:\Office templates\Whole office\General Templates\FEC Letter NFU.dotx"
strWordVersion = DirName & "\ComplaintID" & iComplaintID & "-" & Format(Now, "yyyymmdd") & ".doc"
' open a new instance of word
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
' open the template
Set wrdDoc = wrdApp.Documents.Open(strWordTemplate)
wrdDoc.SaveAs FileName:=strWordVersion, FileFormat:=0
wrdDoc.ActiveWindow.Activate
wrdDoc.ActiveWindow.SetFocus
Set wrdSel = wrdDoc.ActiveWindow.Selection
wrdSel.Find.ClearFormatting
wrdSel.Find.Replacement.ClearFormatting
'PARA 1
'20180123 MO - needed to find a way to paste in the other paras longer than 255
'which is why this loop is here
sContent = sPara1
iParaLength = Len(sContent)
iReplaceLoopCounter = 1
Do While (iParaLength > 0)
sContentTemp = Mid(sContent, (iReplaceLoopCounter * 240) - 239, 240)
sContentTemp = sContentTemp & "[Start Here]"
With wrdSel.Find
.Text = "[Start here]"
.Replacement.Text = sContentTemp
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Debug.Print sContentTemp
wrdSel.Find.Execute replace:=wdReplaceAll
iParaLength = iParaLength - (iReplaceLoopCounter * 240)
iReplaceLoopCounter = iReplaceLoopCounter + 1
If iParaLength < 0 Then Exit Do
Loop
'PARA 2
sContent = vbCrLf & vbCrLf & sPara2
iParaLength = Len(sContent)
iReplaceLoopCounter = 1
Do While (iParaLength > 0)
sContentTemp = Mid(sContent, (iReplaceLoopCounter * 240) - 239, 240)
sContentTemp = sContentTemp & "[Start Here]"
With wrdSel.Find
.Text = "[Start here]"
.Replacement.Text = sContentTemp
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Debug.Print sContentTemp
wrdSel.Find.Execute replace:=wdReplaceAll
iParaLength = iParaLength - (iReplaceLoopCounter * 240)
iReplaceLoopCounter = iReplaceLoopCounter + 1
If iParaLength < 0 Then Exit Do
Loop
'PARA 3
sContent = vbCrLf & vbCrLf & sPara3
iParaLength = Len(sContent)
iReplaceLoopCounter = 1
Do While (iParaLength > 0)
sContentTemp = Mid(sContent, (iReplaceLoopCounter * 240) - 239, 240)
sContentTemp = sContentTemp & "[Start Here]"
With wrdSel.Find
.Text = "[Start here]"
.Replacement.Text = sContentTemp
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Debug.Print sContentTemp
wrdSel.Find.Execute replace:=wdReplaceAll
iParaLength = iParaLength - (iReplaceLoopCounter * 240)
iReplaceLoopCounter = iReplaceLoopCounter + 1
If iParaLength < 0 Then Exit Do
Loop
'get rid of the last [Start Here]
sContentTemp = ""
With wrdSel.Find
.Text = "[Start here]"
.Replacement.Text = sContentTemp
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
wrdSel.Find.Execute replace:=wdReplaceAll
'save temp file to customer folder
strWordTemplateTemp = DirName & "\ComplaintID" & iComplaintID & "-" & Format(Now, "yyyymmdd") & ".pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
strWordTemplateTemp, ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=True, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
Спасибо - я ценю любую помощь. Это мой первый пост.
2 ответа
Спасибо за вашу помощь и совет. Обрезка пробелов в начале абзаца не решает проблему, но указывает на то, в чем проблема.
Мне пришлось заменить "vbcrlf" в моем коде доступа vba на "Chr(10) & Chr(13) & ", но мне также пришлось заменить "Chr(13) & Chr(10) & " на "Chr (10) & Chr (13) & "для каждой строки, которую я извлек из таблицы доступа. Параграфы в таблице имели возвраты, и, идентифицировав код символов ascii, они получили 13, а затем 10. Переключение между ними позволило убрать начальный пробел.
Я не думаю, что я правильно описал проблему, и я должен был добавить пример вывода - это сделало бы то, что происходило яснее. И, как указала кружка Мэта, мне следовало сократить код, который я разместил.
Мое первое предложение - команда VBA Trim
(например ValidPara = Trim(sPara)
). Trim
удалит конечный и ведущий пробел из вашего абзаца. Тем не менее, он также преобразует несколько пробелов внутри абзаца в одиночные пробелы. Это должно быть приемлемо для вашего случая.
На это распространяется команда VBA. LTrim
(например ValidPara = LTrim(sPara)
). Это только удаляет ведущие пробелы и, вероятно, является наиболее подходящим для того, что вы хотите сделать.
Другой вариант немного сложнее. В этом примере я предполагаю, что перед абзацем есть только один недопустимый пробел
If Left(sPara,1) = " " Then
ValidPara = Right(sPara, Len(sPara)-1) ' removes first character from string
End If
Если перед абзацем несколько пробелов, вы можете изменить If-End If
заявление к While-Wend
петля. Кроме того, приведенный выше код может быть изменен для удаления других странных символов, если вы когда-нибудь окажетесь в такой ситуации.