variare dati in diversi file word

[lorenzo.casali]

ciao,
è possibile variare dei dati (nello specifico una data di revisione documento) su più file word senza farlo necessariamente manualmente aprendone uno per uno ? ho circa 120 file word in cui debbo sostituire la data di revisione documento apposta in calce al documento.

grazie.
ciao.
Lorenzo

[wallace&gromit]

Si sono viste poche macro per word in questo forum ma penso che sia fattibile.
I file sono tutti nella stessa cartella?
La data da cambiare è riconoscibile in modo univoco o con un "trova e sostituisci" si rischia di cambiare anche altre date nel testo che invece devono rimanere?
Chiedo questo per partire, ma non sono sicuro di riuscire a combinare qualcosa di buono, vediamo se qualcuno ci dà una mano.

[lorenzo.casali]

si sono in un unica cartella.
la data è riconoscibile in modo univoco.

[Anthony47]

Purtroppo sapere che "la data è riconoscibile in modo univoco" conferma solo che la cosa e' possibile; per "come farlo" vorrei vedere il format del documento, cioe' un paio di file con dati verosimili (e non e' escluso che seguano altre domande).
Per le istruzioni su come allegare un file:
viewtopic.php?f=26&t=103893&p=605487#p605487

Ciao

[lorenzo.casali]

il link del documento ... funziona ?
http://www.filedropper.com/12mod7403rev ... afornitore

[Anthony47]

Ho scaricato il documento, ma non ho capito con quale regola identifico in modo univoco la data da sostituire.

[lorenzo.casali]

ah.. scusa Anthony,.... intendevo che non vi erano altre date all'interno del documento che potessero essere confuse con quella che devo sostituire (cfr wallace&gromit » 05/05/17 17:01). in effetti la data è inserita semplicemente in fondo al modello, non è in intestazione/piè di pagina o come segnalibro etc.... . mi sa che si può fare ben poco vero.... ?

[patel]

la data è sempre la stessa ? viene inserita sempre nella stessa posizione rispetto a Data: ?
si potrebbe sostituire l'intera ultima riga ?

[lorenzo.casali]

si per tutte e tre le domande.

[patel]

prova questa valida per un solo file

Codice: Seleziona tutto

Sub FR2()
    Dim WordApp As Object
    nuovadata = "09/05/2017" 
    vecchiadata = "04/04/2016"
    fname = "C:\nome del file.doc" ' <<<<< nome del file da modificare
    '------------------------------------------------------------------------
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open(fname)
    Set WordContent = WordDoc.Content
    WordContent.Find.Execute FindText:=vecchiadata, ReplaceWith:=nuovadata
    WordDoc.Close True
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub

[lorenzo.casali]

mi da sempre errore di run time "impossibile trovare il file" .... eppure il percorso/nome del file è quello che ho riportato....

[patel]

controlla il percorso

[lorenzo.casali]

eppure il percorso è corretto....
http://www.filedropper.com/errorevba

[patel]

non è corretto, manca l'estensione .doc

[lorenzo.casali]

si si l'ho messo anche prima e ho fatto varie prove ma non funziona mi da sempre run time '5174'

[patel]

è il tipico errore di file not found, sbagli qualcosa
posta uno screen della cartella in cui si trova il file e la macro corretta

[lorenzo.casali]

potrebbe essere un problema relativo a word ?.... in allegato il "problema" che ho con word oltre a quanto mi hai chiesto.
http://www.filedropper.com/errorevba_2

[patel]

dalle immagini non si vede il percorso completo del file e neppure l'estensione.
word non c'entra niente, la macro è su excel e non trova il file.
Clicca col destro sul file prova1, proprietà e vedi il percorso
Inoltre abilita la visualizzazione delle estensioni

[Anthony47]

Lavorando sulla macro di patel ho elaborato la seguente proposta.

Partiamo da un file Excel vuoto, e lavoriamo su Foglio1
In un modulo standard del vba, es Modulo1, inserire questa macro:

Codice: Seleziona tutto

Sub RepData()
Dim oFso As Object, SubD As String, dPath As String, myFile As String
Dim WordApp As Object, WordDOC As Object, WordContent As Object
Dim OData As String, NwData As String, mK1 As String, mK2 As String
Dim dFound As Boolean, pText As String, pCount As Long

OData = "04/04/2016"         '<<< La vecchia data...
NwData = "09/05/2017"        '<<< ...da sostituire con questa nuova
mK1 = " Data:_"              'Markers per identificare con buona certezza la data
mK2 = " Firma RGQ_"
SubD = "Reworked"            '<<< I file "lavorati" saranno spostati in questa sottodirectory
'
MsgBox ("Scegliere la directory da cui prelevare i Doc da aggiornare")
With Application.FileDialog(msoFileDialogFolderPicker)
   .Show
    If .SelectedItems.Count = 0 Then
        MsgBox ("Nessuna voce selezionata, processo abortito")
        Exit Sub
    End If
    dPath = .SelectedItems.Item(1) & "\"
End With
'
Set oFso = CreateObject("Scripting.FileSystemObject")
If Not oFso.FolderExists(dPath & SubD) Then
    oFso.CreateFolder (dPath & SubD)
End If
myFile = Dir(dPath & "*.doc*")
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Do
    If myFile = "" Then Exit Do
    DoEvents
    Set WordDOC = WordApp.Documents.Open(dPath & myFile)
    pCount = WordDOC.Paragraphs.Count
    dFound = False
    If pCount > 2 Then
        For i = pCount To pCount - 1 Step -1
            pText = WordDOC.Paragraphs(i).Range.Text
            If InStr(1, pText, mK1, vbTextCompare) > 0 And _
              InStr(1, pText, mK1, vbTextCompare) > 0 And _
              InStr(1, pText, OData, vbTextCompare) > 0 Then
                dFound = True
                pText = Replace(pText, OData, NwData, , , vbTextCompare)
                WordDOC.Paragraphs(i).Range.Text = pText
                WordDOC.Save
                Exit For
            End If
        Next i
    End If
    WordDOC.Close False
    If dFound Then
        Name dPath & myFile As dPath & SubD & "\" & myFile
        mynext = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(mynext, 1) = myFile
        Cells(mynext, 2) = "Y"
    Else
        mynext = Cells(Rows.Count, 1).End(xlUp).Row + 1
        Cells(mynext, 1) = dPath & myFile
        Cells(mynext, 2) = "NO"
        Cells(mynext, 3) = pCount
    End If
myFile = Dir
Loop
'
WordApp.Quit
Set WordDOC = Nothing
Set WordApp = Nothing
Set oFso = Nothing
End Sub


A questo punto si puo' lanciare la Sub RepData.
Essa chiede all'utente di selezionare la directory in cui sono localizzati i file; poi apre una nuova sessione di Word e uno dopo l'altro apre i file che trova.
La macro esamina gli ultimi 2 paragrafi del documento, e al loro interno cerca i "marker" indicati come Mk1 e Mk2 e la data da sostituire.
Se trova tutto allora sostituisce la data, salva il documento, lo sposta sulla subdirectory "Reworked" e sul foglio Excel scrive il nome file (colonna A) e il flag Y (colonna B).
Se invece manca qualcosa allora il file viene chiuso e sul foglio si scrive Percorso + Nome del file e il flag No, a indicare che non sono stati processati.

A questo punto, si puo' inserire sul "modulo vba del foglio1" questo codice:

Codice: Seleziona tutto

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, _
    ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Target.Column > 1 Then Exit Sub
  Dim lngx As Long
  lngx = ShellExecute(vbNull, "Open", Target.Value, "", "", vbNormalFocus)
End Sub

(tasto dx sul tab col nomefile; scegli Visualizza codice, incollare il codice nel modulo vba che si apre)
In questo modo facendo doppioclick sui nomi dei file non processati essi saranno aperti e visualizzati in Word; cosi' si puo' modificarli manualmente oppure correggere il motivo per cui non erano stati processati automaticamente e ripetere la Sub RepData

Ciao

[patel]

Più efficiente e completa di così non potrebbe essere !