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
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