Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Fetching data from one word document to another!

Status
Not open for further replies.

kalle82

Technical User
Apr 2, 2009
163
SE
HI!

Ive found some code that i put into a macro.

Ill post it after my question.

Question is: I cant get the code to fetch anything, the real problem is that i dont know how to set up the document filled with data.

Option Explicit
Const METASUFFIX = "md" 'suffix på metadatafilen
Const METASUFFIX1 = "Metadata-forfragan.doc.md" 'suffix på metadatafilen
Const RUBRIK = "metadata" 'rubrik i metadata filen där makrona letar efter fälten
Sub AutoOpen()
Call startMakro
End Sub
Sub startMakro()
Dim lclDocName As String
Dim lclFileName As String
Dim ix As Integer
' sätter namn & sökväg till textfilen
Word.StatusBar = "Startar makro."
ix = InStr(ActiveDocument.Name, ".")
If ix = 0 Then
lclDocName = ActiveDocument.Path & "\" & ActiveDocument.Name & "."
Else
lclDocName = ActiveDocument.Path & "\" & Mid(ActiveDocument.Name, 1, ix)
End If
' kollar om det finns en .md fil
lclFileName = LCase(lclDocName & METASUFFIX)
Word.StatusBar = "Söker metadatafil " & lclFileName
If Len(Dir(lclFileName)) <> 0 Then
Call readTextFileMeta(lclFileName)
GoTo startMakro_end
End If
' kollar om det finns en .doc.md fil
lclFileName = LCase(lclDocName & METASUFFIX1)
Word.StatusBar = "Söker metadatafil " & lclFileName
If Len(Dir(lclFileName)) <> 0 Then
Call readTextFileMeta(lclFileName)

GoTo startMakro_end
End If
startMakro_end:
Word.StatusBar = "Klar, läst metadatafil " & lclFileName
End Sub
Sub readTextFileMeta(lclFileName As String)
' öppnar metadata textfilen och läser den från början till slut
On Error Resume Next
Dim lclInPost As String
Dim ix As Integer
Dim lclOK As Boolean
Dim lclRubrik As String
Dim lclText As String
Dim lclField As FormField
Dim lclFieldName As String
lclOK = False
Open lclFileName For Input As #1
Word.StatusBar = "Läser metadatafil " & lclFileName & "."
While Not EOF(1)
Line Input #1, lclInPost
' letar först efter rätt rubrik i metadatafilen
If Mid(lclInPost, 1, 1) = "[" Then
If LCase(Mid(lclInPost, 2, 8)) = RUBRIK Then
lclOK = True
Else
lclOK = False
End If
End If
If lclOK = True Then
' om rätt rubrik, kollar om det funna värdet ska användas
ix = InStr(lclInPost, "=")
If ix > 0 Then
lclRubrik = LCase(Trim(Mid(lclInPost, 1, ix - 1)))
lclRubrik = Replace(lclRubrik, "-", "_")
lclText = Trim(Mid(lclInPost, ix + 1))

' letar igenom alla fält för att se om metadatafältet ska med i dokumentet
' Om ett metadatafält ska vara med flera gånger
' ska det heta <namn>1, <namn>2 osv.
For Each lclField In ActiveDocument.FormFields
lclFieldName = LCase(lclField.Name)
If LCase(lclRubrik) = lclFieldName Or _
(LCase(lclRubrik) = Mid(lclFieldName, 1, Len(lclRubrik)) And Val(Mid(lclFieldName, Len(lclRubrik) + 1)) > 0) Then
lclField.Result = lclText
End If
Next lclField
Call tilldelaText(lclRubrik, lclText)
End If
End If
Wend
readTextFileMeta_end:
Reset
End Sub
Sub tilldelaText(lclRubrik As String, lclText As String)
' tilldelar textboxar i dokumentet
' textboxtilldelningen måste hårdkodas
' för att lägga till en ny textbox i koden, kopiera :
'
' Case "<metadatafält>"
' ActiveDocument.<metadatafält> = lclText
'
' ändra först Case "<metadatafält>" till metadatafältets namn, t.ex. Case "datum"
' ändra sen ActiveDocument.<metadatafält> till namnet på textboxen i dokumentet t.ex. ActiveDocument.Datum = lclText
' Om textboxen inte finns i dokumentet kommer det inte att bli fel, koden kommer att forsätta
On Error Resume Next
Select Case lclRubrik
Case LCase("Objektnamn")
ActiveWorkbook.Sheets(1).Objektnamn = lclText
Case LCase("Objektnr")
ActiveWorkbook.Sheets(1).Objektnr = lclText
Case LCase("Foretag")

ActiveWorkbook.Sheets(1).Foretag = lclText
Case LCase("Adress")
ActiveWorkbook.Sheets(1).Adress = lclText
Case LCase("Postadress")
ActiveWorkbook.Sheets(1).Postadress = lclText
Case LCase("Mot")
ActiveWorkbook.Sheets(1).Mot = lclText
Case LCase("MotAdress")
ActiveWorkbook.Sheets(1).MotAdress = lclText
Case LCase("MotPostadress")
ActiveWorkbook.Sheets(1).MotPostadress = lclText
End Select
End Sub

Would be nice with help :)
 
I guess the first question is "where is this code failing and what is the nature of the failure?".

That said, you appear to be opening the file to read the data from as a text file:
readTextFileMeta said:
Open lclFileName For Input As #1
Yet you imply in your post title that it's a Word Document. They're different.


_________________
Bob Rashkin
 
Also, I am a bit confused as to where this code is being run from. You have:
Code:
ActiveWorkbook.Sheets(1).Foretag = lclText
which is Excel. But you also have:
Code:
For Each lclField In ActiveDocument.FormFields
which is Word.

In neither case do I see you making an instance of one (or the other).

Also, could you please use the TGML code tags when posting code? Thanks.

Gerry
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top