通过VBA将MS Word数据从文本框（ActiveX控件）导入MS Access表

Question

我有代码，可以从文本框（ActiveX 控件）将数据从 Word 导入到 Access 表。代码以 MS Access 的“Osoba”形式编写。

Access DB 名称：Proba db 表名：Osoba 行名称：Ime 词名：AOO 文本框名称：Ime_W

代码（选项 1 使用“书签”）：

Private Sub Command10_Click()
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim textBoxValue As String
    Dim db As Database
    Dim rs As Recordset   
    ' Otvara Word aplikaciju
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If wordApp Is Nothing Then
        Set wordApp = CreateObject("Word.Application")
    End If
    wordApp.Visible = True ' Prikazuje Word aplikaciju   
    ' Dohvati putanju do Word dokumenta
    Dim filePath As String
    filePath = "C:\Users\10466237\Desktop\Automatsko prebacivanje iz worda u access\A00.docm" ' Zamijenite ovu putanju sa stvarnom putanjom do vašeg dokumenta  
    ' Provjera da li je datoteka dostupna
    If Dir(filePath) = "" Then
        MsgBox "Nije pronaden Word dokument na zadatoj putanji.", vbExclamation
        Exit Sub
    End If  
    ' Otvara postojeci Word dokument
    Set wordDoc = wordApp.Documents.Open(filePath)   
    ' Dohvati vrijednost iz TextBoxa u Word dokumentu putem Bookmarka
    Dim bookmarkName As String   
    ' Postavljamo ime bookmarka koje smo dodijelili TextBoxu
    bookmarkName = "Ime_W_Bookmark"  
    ' Provjeravamo da li bookmark postoji u Word dokumentu
    If wordDoc.Bookmarks.Exists(bookmarkName) Then
        ' Ako postoji, dohvatimo tekst iz bookmarka
        textBoxValue = wordDoc.Bookmarks(bookmarkName).Range.Text
    Else
        ' Ako ne postoji, prikažemo poruku o grešci
        MsgBox "Bookmark 'Ime_W_Bookmark' nije pronaden u Word dokumentu.", vbExclamation
        wordDoc.Close
        Set wordDoc = Nothing
        Set wordApp = Nothing
        Exit Sub
    End If    
    ' Zatvara Word dokument
    wordDoc.Close
    ' Cisti memoriju
    Set wordDoc = Nothing
    Set wordApp = Nothing  
    ' Otvara Access bazu podataka
    Set db = CurrentDb
    ' Dodaj podatak u tabelu u Access bazi podataka
    Set rs = db.OpenRecordset("Osoba")
    rs.AddNew
    rs!Ime = textBoxValue
    rs.Update
    rs.Close    
    ' Cisti memoriju
    Set rs = Nothing
    Set db = Nothing   
    MsgBox "Podatak uspješno prebacen u tabelu.", vbInformation
End Sub

选项 1 的结果：请参阅 atta1

代码（使用“ActiveX Control”的选项 2）：

Private Sub Command11_Click()
    Dim wordApp As Object
    Dim wordDoc As Object
    Dim textBoxValue As String
    Dim db As Database
    Dim rs As Recordset    
    ' Otvara Word aplikaciju
    On Error Resume Next
    Set wordApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If wordApp Is Nothing Then
        Set wordApp = CreateObject("Word.Application")
    End If
    wordApp.Visible = True ' Prikazuje Word aplikaciju   
    ' Dohvati putanju do Word dokumenta
    Dim filePath As String
    filePath = "C:\Users\10466237\Desktop\Automatsko prebacivanje iz worda u access\A00.docm" ' Zamijenite ovu putanju sa stvarnom putanjom do vašeg dokumenta    
    ' Provjera da li je datoteka dostupna
    If Dir(filePath) = "" Then
        MsgBox "Nije pronaden Word dokument na zadatoj putanji.", vbExclamation
        Exit Sub
    End If   
    ' Otvara postojeci Word dokument
    Set wordDoc = wordApp.Documents.Open(filePath)    
    ' Dohvati vrijednost iz ActiveX kontrole u Word dokumentu
    Dim controlName As String
    controlName = "Ime_W" ' Zamijenite ovu vrijednost sa imenom vaše ActiveX kontrole   
    ' Provjerava da li kontrola postoji u Word dokumentu
    If wordDoc.Shapes(controlName) Is Nothing Then
        MsgBox "ActiveX kontrola '" & controlName & "' nije pronadena u Word dokumentu.", vbExclamation
        wordDoc.Close
        Set wordDoc = Nothing
        Set wordApp = Nothing
        Exit Sub
    End If  
    ' Dohvati vrijednost iz ActiveX kontrole
    textBoxValue = wordDoc.Shapes(controlName).OLEFormat.Object.Text  
    ' Zatvara Word dokument
    'wordDoc.Close 
    ' Cisti memoriju
    Set wordDoc = Nothing
    Set wordApp = Nothing 
    ' Otvara Access bazu podataka
    Set db = CurrentDb 
    ' Dodaj podatak u tabelu u Access bazi podataka
    Set rs = db.OpenRecordset("Osoba")
    rs.AddNew
    rs!Ime = textBoxValue
    rs.Update
    rs.Close 
    ' Cisti memoriju
    Set rs = Nothing
    Set db = Nothing
    MsgBox "Podatak uspješno prebacen u tabelu.", vbInformation
End Sub

选项 2 的结果：错误

有人可以帮助我吗？

Answer 1

• Word中有两种形状。

例如。假设 ActiveX TextBox 是文档中的唯一对象。您可以通过以下代码获取该值。

Sub Demo()
    Dim oShp As Object
    With ActiveDocument
        If .InlineShapes.Count > 0 Then
            Set oShp = .InlineShapes(1)
        ElseIf .Shapes.Count > 0 Then
            Set oShp = .Shapes(1)
        End If
    End With
    If Not oShp Is Nothing Then MsgBox oShp.OLEFormat.Object.Text
End Sub