Question

我有一张访问权限表，其中包含要写给客户的信件段落。每个字母都有多个段落。

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

我使用下面的代码进行粘贴（240个字符批次，因为任何更大的代码都会产生＆＃34;太多字符＆＃34;错误消息）

一切正常，除了每个段落的第一行，每一行都用空格缩进。

我重新创建了单词模板。我已经检查了段落和对齐的单词。也没有制表位。

我正在使用Windows 10，Office 2010，访问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

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

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;”。对于我从访问表中提取的每个字符串，“with”Chr（10）＆amp; Chr（13）＆amp;“。表中的段落有返回，并通过识别字符的ascii代码，它们出现为13然后10.切换它们消除了前导空间。

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

使用Access VBA替换单词中的字符串会在段落开头生成无关的空间

2 个答案: