使用Access VBA替换字符串在段落开始时会生成无关的空间

Question

我有一张访问中的表，该表包含段落供您交给客户的段落。每个字母都有许多段落。

在我们的服务器上有模板文档。

我使用下面的代码粘贴(以240个字符批次，因为任何较大的东西会生成"太多字符"错误消息(

除了每个段落的第一行以外，这一切都很好，每行都被一个空间缩进。

我已经重新创建了单词模板。我已经检查了Word中的段落和对齐方式。也没有标签停止。

我正在使用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 EnquiriesCustomer_FilesID " & 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 templatesWhole officeGeneral TemplatesFEC 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

谢谢 - 感谢任何帮助。这是我的第一篇文章。

Answer 1

我的第一个建议是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循环。此外，如果您在这种情况下发现自己，则可以修改上述代码以剥离其他奇怪的字符。

Answer 2

感谢您的帮助和建议。从段落的正面修剪空间并不能解决问题，而是指出问题是什么。

我必须用" chr(10(＆amp; chr(13(＆amp;"在访问VBA代码中替换" vbcrlf"，但我也必须替换" chr(13(＆amp; chr(10(＆amp;"使用" Chr(10(＆amp; chr(13(＆amp;"对于我从访问表中拔出的每个字符串。表中的段落有返回，并通过识别字符的ASCII代码，它们出现为13，然后是10。将其切换到消除领先空间。

我认为我没有正确描述这个问题，我应该添加一个输出的示例 - 这会使事情变得更加清晰。正如Mat的杯子指出的那样，我应该减少我发布的代码。