[Excell + Word] Script-Macro per automatizare l'importazione di dati da moduli Word

[StefSeb]

Gentilissimi dovrei creare uno script per automatizzare la lettura scrittura di alcuni dati depositati in moduli word.
Ho 60 moduli contenenti circa 250 campi ogni modulo da caricare in un db.
Pensavo di passare da un foglio di calcolo.
Lo script che pensavo (ma che non so scrivere!) era “dentro al foglio di calcolo" (office 2003 o 2010 o libreoffice) e dovrebbe fare:
A) Spostati nella directory “ C:\Folder”
B) Apri il primo file *.doc in word (o il corrispettivo di libre)
C) Imposta salva dati modulo in un file txt (SaveFormsData:=True,)
D) Salva il file txt.

    ATTENZIONE primo mio bivio decisionale salvare il file con lo stesso nome del file doc oppure salvare il nome del file origine DENTRO al file come primo campo separato da “;” – se si sceglie questa seconda ipotesi dopo devo fare un “attachment” dei dati del secondo .doc in questo stesso file.

E) Chiudi file .doc
F) Sposta questo file .doc in C:\Folder\copiati
G) Apri secondo file doc e ripeti tutti i passaggi precedenti.
Se file txt con nome file doc crea nuovo se file con primo campo nome file doc accoda a file esistente.
H) Quando nella directory Folder non vi sono più file doc
1A) SE file unico con vari attachment importa in foglio di calcolo e salvalo con nome DATIMODULI.XLS

1B) SE tanti file txt ALLORA scrivi in cella A1 il nome del file copia da cella B1 a CELLA IQ1
2B) Sposta file txt in C:\Folder\copiati
3B) Apri secondo file txt e ripeti passaggio precedente.
4B) Salva file come DATIMODULI.XLS.

Mi potete aiutare?

[StefSeb]

Cercando in rete ho messo assieme questo codice MA NON FUNZIONA!!!

Attribute VB_Name = "prova_macro"
Public Sub prova_elab()

On Error GoTo RigaErrore
    
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    
    Dim sPath As String
    Dim Destinatione As String
    
    Dim NomeCompleto As String
    Dim NomeFile As String
    Dim NomeSenzaExt As String
        
    Destinatione = "C:\Folder\Temp\"
    sPath = "C:\Folder\"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(sPath)
 '
 ' non so come impostare NomeCompleto (stringa) = objFile (oggetto)
 '
    NomeFile = Mid(NomeCompleto, InStrRev(NomeCompleto, "\") + 1)
    NomeSenzaExt = Left(NomeFile, InStrRev(NomeFile, ".") - 1)
  
   
    For Each objFile In objFolder.Files
    MsgBox NomeCompleto
    

    Documents.Open NameFile = objFile, ConfirmConversions:= _
    False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", 

_
    PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
    WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

Application.DisplayStatusBar = True
Application.ShowWindowsInTaskbar = True
Application.ShowStartupDialog = True
With ActiveWindow
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
        .DisplayLeftScrollBar = False
        .StyleAreaWidth = CentimetersToPoints(0)
        .DisplayVerticalRuler = True
        .DisplayRightRuler = False
        .DisplayScreenTips = True
        With .View
            .ShowAnimation = True
            .Draft = False
            .WrapToWindow = False
            .ShowPicturePlaceHolders = False
            .ShowFieldCodes = False
            .ShowBookmarks = False
            .FieldShading = wdFieldShadingWhenSelected
            .ShowTabs = False
            .ShowSpaces = False
            .ShowParagraphs = False
            .ShowHyphens = False
            .ShowHiddenText = False
            .ShowAll = True
            .ShowDrawings = True
            .ShowObjectAnchors = False
            .ShowTextBoundaries = False
            .ShowHighlight = True
            .ShowOptionalBreaks = False
            .DisplayPageBoundaries = True
            .DisplaySmartTags = True
        End With
    End With
    With Options
        .LocalNetworkFile = False
        .AllowFastSave = False
        .BackgroundSave = True
        .CreateBackup = False
        .SavePropertiesPrompt = False
        .SaveInterval = 10
        .SaveNormalPrompt = False
        .DisableFeaturesbyDefault = False
    End With
    With ActiveDocument
        .ReadOnlyRecommended = False
        .EmbedTrueTypeFonts = False
        .SaveFormsData = True
        .SaveSubsetFonts = False
        .DoNotEmbedSystemFonts = True
        .Password = ""
        .WritePassword = ""
        .DisableFeatures = False
        .EmbedSmartTags = True
        .SmartTagsAsXMLProps = False
        .EmbedLinguisticData = True
    End With
    Application.DefaultSaveFormat = ""
    ChangeFileOpenDirectory _
    "C:\Folder"
    ActiveDocument.SaveAs FileName:="NomeSenzaExt & .txt", FileFormat:= _
        wdFormatText, LockComments:=False, Password:="", 

AddToRecentFiles:=True, _
        WritePassword:="", ReadOnlyRecommended:=False, 

EmbedTrueTypeFonts:=False, _
         SaveNativePictureFormat:=False, SaveFormsData:=True, 

SaveAsAOCELetter:= _
        False, Encoding:=1252, InsertLineBreaks:=True, 

AllowSubstitutions:=False, _
         LineEnding:=wdCRLF
         Contatore = Contatore + 1
    ActiveDocument.Close
    
    
    
    MoveFile NomeCompleto Destinazione
      
    
    Next
   
RigaChiusura:
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing

    Exit Sub
 
RigaErrore:
    MsgBox Err.Number & "linea " & vbNewLine & Err.Description
    Resume RigaChiusura
        
End Sub

Riuscite a darmi una mano?