vbams-accessms-word

Import MS Word data from textbox (ActiveX Control) to MS Access table by VBA


I have code, that imports data from textbox (ActiveX Control), from Word to Access table. Code is written in form "Osoba" of MS Access.

Name of Access DB: Proba db Name of table: Osoba Name of row: Ime Name of Word: AOO Name of textbox: Ime_W

Code (Option 1 using "Bookmark"):

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

Result of option 1: Please see atta1 enter image description here

Code (Option 2 using "ActiveX Control"):

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

Result of option 2: ERROR

Can someone help me?


Solution

  • eg. Assume the ActiveX TextBox is the only object in your Doc. You can get the value with below code.

    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
    

    Update:

    Microsoft documentation:

    OLEFormat.Object property (Word)

    OLEFormat.ProgID property (Word)

    Sub Demo()
        Dim oShp As Shape, oILShp As InlineShape
        Const TXT_BOX = "TextBox1"
        Const OPT_BTN = "OptionButton1"
        With ActiveDocument
            If .InlineShapes.Count > 0 Then
                For Each oILShp In .InlineShapes
                    With oILShp.OLEFormat
                        Debug.Print "InlineShape", .ProgID, .Object.Name, .Object.Value
                        If .Object.Name = TXT_BOX And .ProgID = "Forms.TextBox.1" Then
                            MsgBox .Object.Name & vbTab & .Object.Value
                        ElseIf .Object.Name = OPT_BTN And .ProgID = "Forms.OptionButton.1" Then
                            MsgBox .Object.Name & vbTab & .Object.Value
                        End If
                    End With
                Next
            End If
            If .Shapes.Count > 0 Then
                For Each oShp In .Shapes
                    With oShp.OLEFormat
                        Debug.Print "InlineShape", .ProgID, .Object.Name, .Object.Value
                        If .Object.Name = TXT_BOX And .ProgID = "Forms.TextBox.1" Then
                            MsgBox .Object.Name & vbTab & .Object.Value
                        ElseIf .Object.Name = OPT_BTN And .ProgID = "Forms.OptionButton.1" Then
                            MsgBox .Object.Name & vbTab & .Object.Value
                        End If
                    End With
                Next
            End If
        End With
    End Sub