Question

这是我的问题：

我有一个.csv文件，其中包含代表条形码的字符串。需要使用Avery Label纸上的Word中的Code 39字体打印条形码。

为此，我创建了一个.dotm文件。在.dotm文件中，我使用.csv文件作为数据源创建了邮件合并。一切正常，但条形码阅读器打印标签不易辨认。

为了解决这个问题，我在VBA文件的Document_Open上创建了一个.dotm宏，在条形码字符串的开头和结尾添加*。我希望宏打开.csv文件，读取它，用适当的字符串替换条形码字符串，然后在邮件合并发生之前将其写回.csv。

打开.dotm文件后，我得到了 -

许可被拒绝。

如果我从VBA编辑器中运行VBA代码，它运行时没有任何错误。我不确定从哪个位置收到错误。

甚至可以做我想做的事情吗？

这是我的VBA代码：

Private Sub Document_Open()
Const ForReading = 1
Const ForWriting = 2

Dim oFSO, f, FilePath, ts, sLine, line, FileContent, sBar, sBarcode
Dim LineArray As Variant
Dim CodesArray() As String
Dim tFile As Integer
Dim tFile1 As Integer
Dim a As Long
Dim b As Long

FilePath = "\\mkaccup01\c$\AccutracXE\Barcode.csv"

tFile = FreeFile

'Open the datasource, read it, and modify it
Open FilePath For Input As tFile

FileContent = Input(LOF(tFile), tFile)

Close tFile

LineArray = Split(FileContent, vbCrLf)
ReDim CodesArray(0 To 2) As String

For Each sLine In LineArray

    CodesArray = Split(sLine, ",")
    For Each line In CodesArray
        sBar = CodesArray(0)
        sBarcode = "*" & sBar & "*"
    Next

    FileContent = Replace(FileContent, sBar, sBarcode)
Next

'Open datasource back up and save the modifications
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set f = oFSO.GetFile(FilePath)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

ts.Write FileContent
ts.Close
End Sub

Answer 1

我最终采取了另一条路线。我创建了一个.dotm文件，添加了代码来读取＆amp;修改数据源，然后添加编码以在新文档中创建邮件合并。这照顾了我的更新问题，但现在我需要更改合并中字段的字体：

Private Sub Document_Open()
  ModifyDataSource
  CreateMerge
End Sub

Function CreateMerge()
Dim oApp As Word.Application
Dim oDoc As Word.Document

'Start a new document in Word
Set oApp = CreateObject("Word.Application")
Set oDoc = oApp.Documents.Add

With oDoc.MailMerge

    'Insert the mail merge fields temporarily so that
    'you can use the range that contains the merge fields as a layout
    'for your labels -- to use this as a layout, you can add it
    'as an AutoText entry.
    With .Fields
        .Add oApp.selection.Range, "barcode"
        oApp.selection.TypeParagraph
    End With
    Dim oAutoText As Word.AutoTextEntry
    Set oAutoText = oApp.NormalTemplate.AutoTextEntries.Add("MyLabelLayout", oDoc.Content)
    oDoc.Content.Delete 'Merge fields in document no longer needed now
                        'that the AutoText entry for the label layout
                        'has been added so delete it.

    'Set up the mail merge type as mailing labels and use
    'a tab-delimited text file as the data source.
    .MainDocumentType = wdMailingLabels
    .OpenDataSource Name:="\\mkaccup01\c$\AccutracXE\BARCODE.csv" 'Specify the data source here

    'Create the new document for the labels using the AutoText entry
    'you added -- 5160 is the label number to use for this sample.
    'You can specify the label number you want to use for the output
    'in the Name argument.
    oApp.MailingLabel.CreateNewDocument Address:="", _
        AutoText:="MyLabelLayout", LaserTray:=wdPrinterManualFeed

    'Execute the mail merge to generate the labels.
    .Destination = wdSendToNewDocument
    .Execute

    'Delete the AutoText entry you added
    oAutoText.Delete

End With

'Close the original document and make Word visible so that
'the mail merge results are displayed
oDoc.Close False
oApp.Visible = True

'Prevent save to Normal template when user exits Word
oApp.NormalTemplate.Saved = True
End Function

Function ModifyDataSource()
Const ForReading = 1
Const ForWriting = 2

Dim oFSO, f, FilePath, ts, sLine, line, FileContent, sBar, sBarcode
Dim LineArray As Variant
Dim CodesArray() As String
Dim tFile As Integer
Dim tFile1 As Integer
Dim a As Long
Dim b As Long

FilePath = "\\mkaccup01\c$\AccutracXE\Barcode.csv"

tFile = FreeFile

'Open the datasource, read it, and modify it
Open FilePath For Input As tFile

FileContent = Input(LOF(tFile), tFile)

Close tFile

LineArray = Split(FileContent, vbCrLf)
ReDim CodesArray(0 To 2) As String

For Each sLine In LineArray
    CodesArray = Split(sLine, ",")
    For Each line In CodesArray
        sBar = CodesArray(0)
        sBarcode = "*" & sBar & "*"
    Next
    FileContent = Replace(FileContent, sBar, sBarcode)
Next

'Open datasource back up and save the modifications
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set f = oFSO.GetFile(FilePath)
Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)

ts.Write FileContent
ts.Close
End Function

使用vba在合并之前更新Word Mail Merge数据源

1 个答案: