[源碼]Access導(dǎo)出到Word的VBA代碼

ui

可以通過(guò)VBA將access內(nèi)容導(dǎo)出到word，代碼如下
Private Sub 導(dǎo)出word_Click()
    On Error GoTo ErrorHandler
    Dim strTemplate As String
    Dim strFileName As String
    Dim objApp As Object    'New Word.Application
    Dim objDoc As Object    'Word.Document
    Dim objField As Object    'Word.Field
    Dim rst As Object
    Dim blnNoQuit As Boolean
    strTemplate = CurrentProject.Path & "\模板\通知單模板.doc"
    '設(shè)置鼠標(biāo)指針為沙漏形狀
    DoCmd.Hourglass True
    Set objApp = CreateObject("Word.Application")
    Set objDoc = objApp.Documents.Open(strTemplate)
    Set rst = CurrentDb.OpenRecordset("SELECT * FROM tbl通知單 WHERE ID=" & ID, , 4)    'dbReadOnly
    If Not rst.EOF Then
        strFileName = CurrentProject.Path & "\存放位置\" & "通知單" & rst!ID & ".doc"
        '如果文件已存在，先刪除已有文件
        If Dir(strFileName) <> "" Then Kill strFileName
        objDoc.FormFields("鋼筋綁扎胎具").result = rst!鋼筋綁扎胎具
        objDoc.FormFields("橋梁名稱").result = rst!橋梁名稱
        objDoc.FormFields("箱梁編號(hào)").result = rst!箱梁編號(hào)
        objDoc.FormFields("份數(shù)").result = Nz(rst!份數(shù))
        objDoc.FormFields("鋼筋吊裝時(shí)間").result = Format(rst!鋼筋吊裝時(shí)間, "yyyy年m月d日")
        objDoc.FormFields("交接人").result = rst!交接人
        objDoc.FormFields("字段1").result = rst!字段1
    End If
    rst.Close
    objDoc.SaveAs strFileName
    Beep
    If MsgBox("導(dǎo)出已完成，是否打開(kāi)該文件？", vbQuestion + vbYesNo, "導(dǎo)出完成") = vbYes Then
        objApp.Visible = True
        objDoc.Saved = True
        blnNoQuit = True
    End If
ExitHere:
    On Error Resume Next
    If Not blnNoQuit Then
        If Not objDoc Is Nothing Then objDoc.Saved = True
        If Not objApp Is Nothing Then objApp.Quit
    End If
    '恢復(fù)鼠標(biāo)指針
    DoCmd.Hourglass False
    '釋放對(duì)象變量?jī)?nèi)存
    Set objApp = Nothing
    Set objDoc = Nothing
    Set rst = Nothing
    Exit Sub
ErrorHandler:        '錯(cuò)誤處理程序
    If Err = 70 Then
        MsgBox "不能替換文件，因?yàn)闊o(wú)法刪除已有文件，可能的原因有：" & vbCrLf & vbCrLf & _
               "1.該文件處于打開(kāi)狀態(tài)。" & vbCrLf & _
               "2.沒(méi)有對(duì)此目錄的寫(xiě)入權(quán)限。", vbCritical
    Else
        MsgBox Err.Description, vbCritical, "出錯(cuò) #" & Err
    End If
    Resume ExitHere
End Sub
摘自網(wǎng)絡(luò)

玉樹(shù)TMD臨風(fēng)

正好需要，謝謝

wuwu200222

學(xué)習(xí)

wuwu200222

學(xué)習(xí)

wuwu200222

學(xué)習(xí)

GOODWIN

學(xué)習(xí)

yancx

學(xué)習(xí)

390012370

謝謝分享！