1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89
| 'Déclaration des variables utilisable dans tout le programme
Dim FileToOpen 'variable contenant le nom du fichier parcouru
Dim MyDoc As Word.Document
Dim Dossier As String 'variable pour récupérer le nom du dossier contenant les FFT
Dim WordApp As New Word.Application 'variable pour l'ouverture de l'application Word
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
'Dossier = GetDirectory & ""
Dossier = GetDirectory
Else
GetDirectory = ""
End If
End Function
'Programme de copie des données
Sub Importer()
'On demande à l'utilisateur l'emplacement du dossier
Dossier = GetDirectory
'petites vérif sur le dossier
If Len(Dossier) > 3 Then
Dossier = Dossier & "\"
End If
If Dossier = "" Then
MsgBox "Pas de dossier sélectionné"
Exit Sub
End If
'obtient le premier fichier ou répertoire qui est dans "Dossier"
FileToOpen = Dir(Dossier)
'boucle tant que le répertoire n'a pas été entièrement parcouru
Do While (FileToOpen <> "")
If FileToOpen = False Then
Exit Sub
'On vérifie si le fichier entrant dans la boucle est un .doc
ElseIf (Right$(FileToOpen, 4) = ".doc") Then
'Ouvre le document Word
Set MyDoc = WordApp.Documents.Open(FileToOpen)
If MyDoc.ProtectionType <> wdNoProtection Then
MyDoc.Unprotect Password:="" 'retire la protection du document
End If
Application.ScreenUpdating = False 'l'ouverture du document Word est masquée
WordApp.Visible = False 'Word est masqué pendant l'opération
End If
'[Blabla du reste du code pour récupérer les infos que je cherche]
'on passe à l'élément suivant du répertoire
FileToOpen = Dir
Loop
End Sub |
Partager