Использование 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 петля. Кроме того, приведенный выше код может быть изменен для удаления других странных символов, если вы когда-нибудь окажетесь в такой ситуации.

Другие вопросы по тегам