Applicare una macro ad una cartella contenente file .doc

19 views
Skip to first unread message

Raffele Montillo

unread,
Jul 15, 2019, 6:03:39 AM7/15/19
to
salve a tutti,
vorrei chiedervi un favore in relazione all'applicazione di una macro su una serie di file .doc
Premetto che la macro l'ho registrata direttamente in word, non l'ho editata scrivendo il codice perchè non ne sono capace

In sostanza quello di cui ho bisogno è di poter applicare la mia macro ad una serie di file .doc, che posso raggruppare in una specifica cartella se questo può essere di aiuto.

Ad oggi apro i singoli file, applico la macro, e chiudo.
Ma dovendo fare questa operazione per un migliaio di file a settimana, trovare il modo di automatizzarla (magari la lancio ad inizio pausa pranzo) mi verrebbe comodo.

Chiaro, se non si può fare non muore nessuno, ma in ottica ottimizzare i tempi sarebbe un piccolo ma comodo aiuto.

Grazie mille a chi darà il suo contributo alla mia "piccola causa" :)

casanmaner

unread,
Jul 15, 2019, 11:52:24 AM7/15/19
to
Possibile è possibile.
Magari potresti postare il testo della tua macro per vedere come adattarla alla situazione.

Raffele Montillo

unread,
Jul 16, 2019, 12:47:24 PM7/16/19
to
ciao,
intanto ti ringrazio per il tuo interesse!

dunque da quanto mi chiedi mi pare di capire che tu opteresti per ampliare la macro che ho creato io in modo che da sola possa applicarsi a tutti i file di una cartella, ho capito bene?

io in realtà pensavo ad una cosa un pelino diversa, cioè:

io uso molto Photoshop e in Photoshop mi creo le mie azioni (che sono delle macro)
Poi posso decidere di applicare una data azione (quella che preferisco) ad un gruppo di file (che siano essi i file aperti in Photoshop in quel momento oppure i file contenuti in una cartella)

Questo mi consente di poter decidere, per esempio, di applicare l'azione1 alla cartella 1, azione2 alla cartella2 e così via

Il tutto da un menu di photoshop.


Ora mi rendo conto che i 2 software non hanno nulla in comune, ma mi chiedevo se esistesse un modo per applicare una macro a scelta tra 5 o 6 ad una data cartella, quindi una macro che lancia altre macro applicandole a specifiche cartelle.

Nel caso non si potesse fare, pazienza, allora si potrebbe provare ad incrementare il codice.
Intanto allego il codice di una macro (che in sostanza cambia la formattazione):

Sub Distinte()
'
' Distinte Macro
'
'
WordBasic.TogglePortrait Tab:=3, PaperSize:=0, TopMargin:="2", _
BottomMargin:="2", LeftMargin:="2.5", RightMargin:="2", Gutter:="0", _
PageWidth:="27.94", PageHeight:="21.59", Orientation:=1, FirstPage:=0, _
OtherPages:=0, VertAlign:=0, ApplyPropsTo:=0, FacingPages:=0, _
HeaderDistance:="1.27", FooterDistance:="1.27", SectionStart:=2, _
OddAndEvenPages:=0, DifferentFirstPage:=0, Endnotes:=1, LineNum:=0, _
StartingNum:=1, FromText:=wdAutoPosition, CountBy:=0, NumMode:=0, _
TwoOnOne:=0, GutterPosition:=0, LayoutMode:=0, CharsLine:=45, LinesPage:= _
44, CharPitch:=220, LinePitch:=299, DocFontName:="+Body Asian", _
DocFontSize:=11, PageColumns:=1, TextFlow:=0, FirstPageOnLeft:=0, _
SectionType:=1, FolioPrint:=0, ReverseFolio:=0, FolioPages:=1
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(2)
.LeftMargin = CentimetersToPoints(2.5)
.RightMargin = CentimetersToPoints(2)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.27)
.FooterDistance = CentimetersToPoints(1.27)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = True
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
With Selection.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(1.27)
.BottomMargin = CentimetersToPoints(1.27)
.LeftMargin = CentimetersToPoints(1.27)
.RightMargin = CentimetersToPoints(1.27)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.27)
.FooterDistance = CentimetersToPoints(1.27)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = True
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
Selection.PageSetup.TopMargin = CentimetersToPoints(2)
Selection.WholeStory
Selection.Style = ActiveDocument.Styles("Normal")
Selection.ParagraphFormat.LineSpacing = LinesToPoints(1)
WordBasic.OpenOrCloseParaBelow
Selection.Font.Name = "Courier New"
Selection.Font.Size = 8
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientLandscape
.TopMargin = CentimetersToPoints(2)
.BottomMargin = CentimetersToPoints(1.27)
.LeftMargin = CentimetersToPoints(0.9)
.RightMargin = CentimetersToPoints(0.9)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.27)
.FooterDistance = CentimetersToPoints(1.27)
.PageWidth = CentimetersToPoints(29.7)
.PageHeight = CentimetersToPoints(21)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = True
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
ActiveDocument.Save
ActiveDocument.Close
End Sub


casanmaner

unread,
Jul 16, 2019, 6:38:57 PM7/16/19
to
"Tutto" è possibile.
Il problema è capire cosa uno voglia :)
Vedendo il tuo codice registrato sembra che vengano ripetute delle azioni simili più volte ma non sapendo quali sono i tuoi intenti mi diventa difficile interpretare (considerato anche che la mia conoscenza di word a livello VBA non è molto ampia).
Comunque questa macro che ti propongo apre una finestra di dialogo tramite la quale selzionare un percorso.
Tutti i documenti di quel percorso vengono aperti e successivamente chiusi.
Quando un documento viene aperto viene lanciata una "macro" indicata, in formato di stringa, come argomento della routine sNomeMacro.
Ad es. potresti avere una routine come questa:

Sub EseguiDistinte()
Dim sNomeMacro As String
sNomeMacro = "Distinte"
Call ApriDocumentiInPercorsoEdEseguiAzione(sNomeMacro)
End Sub

che richiama la routine ApriDocumentiInPercorsoEdEseguiAzione passando come argomento sNomeMacro il nome della macro "Distinte".

La routine ApriDocumentiInPercorsoEdEseguiAzione è questa:


Sub ApriDocumentiInPercorsoEdEseguiAzione(sNomeMacro As String)
Dim SelectedFolder As String
Dim FSO As Object
Dim oFile As Object
Dim sFileFullName As String
Dim oDoc As Document

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Environ("USERPROFILE") & "\"
.AllowMultiSelect = False
If .Show = -1 Then
SelectedFolder = .SelectedItems(1)
End If
End With


If SelectedFolder <> "" Then
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each oFile In FSO.getFolder(SelectedFolder).Files
If FSO.GetExtensionName(oFile) Like "*doc*" Then
sFileFullName = FSO.GetAbsolutePathName(oFile)
'apre il file
Set oDoc = Documents.Open(FileName:=sFileFullName)

'esegue la macro indicata nella routine principale e passata nella variabile sNomeMacro di questa routine
Application.Run sNomeMacro

'chiude il file (se non è già stato chiuso dalla precedente procedura eventualmente richiamata) salvandolo
On Error Resume Next
oDoc.Close SaveChanges:=True
On Error GoTo 0

End If
Next oFile
Application.ScreenUpdating = True
End If

Set FSO = Nothing
End Sub

Raffele Montillo

unread,
Jul 17, 2019, 9:16:52 AM7/17/19
to
Innanzitutto ti ringrazio per lo sbattimento che ti stai prendendo!!!
dunque, io ho provato ad usare il tuo codice (ho fatto copia incolla di quello che hai scritto così come lo hai scritto togliendo solo i commenti) ma purtroppo non funziona:

si apre la finestra di dialogo in cui mi chiede di scegliere una cartella
la scelgo, clicco su ok, ma poi non succede nulla.

Ho sbagliato qualcosa?
grazie mille!!!

a scanso di ogni possibile equivoco qui trovi uno screenshot:
https://i.postimg.cc/9fXZYg12/Cattura.jpg

casanmaner

unread,
Jul 17, 2019, 9:36:33 AM7/17/19
to
Nella cartella di windows selezionata sono presenti file "Doc"?
Non vedo nel tuo screeshot la macro "Distinte"?
E' presente da qualche parte?

Come ho detto tramite la routine "EseguiDistinte" viene richiamata la routine "ApriDocumentiInPercorsoEdEseguiAzione" assegnando al suo argomento "sNomeMacro" il nome di una macro (in esempio la macro Distinte).
Come potrai notare è presente una istruzione:
Application.Run sNomeMacro

che appunto esegue la macro passata in quell'argomento.
E ciò viene fatto dopo aver aperto un file doc, tra quelli presenti nel percorso selezionato, lavorando sul documento che a seguito dell'apertura risulta attivo.

Raffele Montillo

unread,
Jul 17, 2019, 10:03:31 AM7/17/19
to
ti ringrazio davvero per il tempo e la pazienza che ci stai mettendo!!!

dunque, io non ho inserito la mia macro distinte in mezzo al tuo codice, scusa la stupidaggine della domanda che sto per farti, devo inserire il codice della mia macro da qualche parte?


poi mi sono accorto che, anche se io utilizzo sempre word per fare tutto, i file sono .rtf, c'è da modificare qualcosa dunque o per il tuo codice va bene lo stesso?

grazie infinite, davvero!!

casanmaner

unread,
Jul 17, 2019, 10:30:33 AM7/17/19
to
Il giorno mercoledì 17 luglio 2019 16:03:31 UTC+2, Raffele Montillo ha scritto:
> ti ringrazio davvero per il tempo e la pazienza che ci stai mettendo!!!
>
> dunque, io non ho inserito la mia macro distinte in mezzo al tuo codice, scusa la stupidaggine della domanda che sto per farti, devo inserire il codice della mia macro da qualche parte?

La tua macro dovrebbe essere presente almeno nel progetto VBA del documento dal quale richiami quella principale (che a sua volta richiama la secondaria assegnandogli la macro da eseguire).

>
>
> poi mi sono accorto che, anche se io utilizzo sempre word per fare tutto, i file sono .rtf, c'è da modificare qualcosa dunque o per il tuo codice va bene lo stesso?

Ecco perché non accadeva nulla.

Prova a modificare questa istruzione:
If FSO.GetExtensionName(oFile) Like "*doc*" Then

con:
If FSO.GetExtensionName(oFile) Like "*rtf*" Then

Raffele Montillo

unread,
Jul 17, 2019, 12:13:19 PM7/17/19
to
Funzia!!!! altro che Funzia!!!!!

ti ringrazio tantissimo, davvero!!

scusa se spudoratamente ne approfitto ma voglio chiederti un'altra cosa:

ipotizzando che io debba utilizzare lo stesso sistema per altre Macro, quello che devo modificare è solo la parte iniziale del codice?

tipo una cosa del genere?


Sub EseguiNUOVAMACRO()
Dim sNomeMacro As String
sNomeMacro = "NUOVAMACRO"
Call ApriDocumentiInPercorsoEdEseguiAzione(sNomeMacro)
End Sub

casanmaner

unread,
Jul 17, 2019, 12:19:01 PM7/17/19
to
Sì, puoi creare più macro del genere in modo da assegnare la macro desiderata alla procedura che apre i documenti.
Ovviamente le macro richiamare devono lavorare sull' activedocument.

Raffele Montillo

unread,
Jul 17, 2019, 12:45:35 PM7/17/19
to
Il giorno mercoledì 17 luglio 2019 18:19:01 UTC+2, casanmaner ha scritto:
> Sì, puoi creare più macro del genere in modo da assegnare la macro desiderata alla procedura che apre i documenti.
> Ovviamente le macro richiamare devono lavorare sull' activedocument.

non saprei come ringraziarti!!!

ogni volta che lancerò il tuo codice io ti manderò benedizioni di ogni sorta, in ogni lingua e per ogni religione!!!!!
Reply all
Reply to author
Forward
0 new messages