Search code examples
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
    • There are two kind of shapes in Word.

    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:

    • ProgID returns the programmatic identifier for the specified OLE object, that is its type.

    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