FAQ LibreOffice et Apache OpenOfficeConsultez toutes les FAQ

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
Sub ListeFichiersDuRepertoire_V01 
' 
'Liste tous les fichiers d'un répertoire 
'Les fichiers masqués sont pris en compte 
'Cet exemple permet aussi de vérifier si le répertoire est vide 
' 
Dim Direction As String , Resultat As String 
  
'Indiquez le répertoire cible 
'(La procédure ne renvoie pas d'erreur si le dossier n'existe pas) 
Direction=Dir("C:\Documents and Settings\michel\dossier\general\*.*",0) 
' 
'------ 
'Un autre exemple pour lister uniquement les fichiers de type PDF : 
'Direction=Dir("C:\Documents and Settings\michel\dossier\general\*.pdf",0) 
'------ 
  
Do While Len(Direction) > 0 
	Resultat = Resultat & Chr(13) & Direction 
	Direction=Dir() 
Loop 
  
If Resultat="" then 
	MsgBox "Le répertoire est vide." 
	Else 
	Msgbox Resultat ,,"Liste des fichiers."  
End If 
End Sub

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
Sub ListeFichiersDuRepertoire_V02 
' 
'Liste tous les fichiers d'un répertoire 
'Les fichiers masqués sont pris en compte 
'Cet exemple permet aussi de vérifier si le répertoire est vide 
' 
Dim Chemin As String , NomObj As String , Resultat As String 
Dim oSimpleFileAccess As Object 
Dim i As Integer  
Dim Tableau() 
  
'Attention : la procédure provoque une erreur si le dossier n'existe pas  
Chemin ="C:\Documents and Settings\michel\dossier\general\" 
  
oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" )  
'Transfert la liste des fichiers dans un Tableau 
Tableau = oSimpleFileAccess.getFolderContents(ConvertToURL( Chemin ), True )  
  
If UBound(Tableau)= -1 Then MsgBox "Le répertoire est vide." 
  
For i = 1 To UBound(Tableau) + 1 
	NomObj = Tableau( i-1 )    
	If Not oSimpleFileAccess.isFolder( NomObj ) Then _ 
		Resultat = Resultat & ConvertFromURL( NomObj ) & Chr(13)  
Next i 
  
MsgBox Resultat 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub listerRepertoires_V01 
Dim Cible As String , Chemin As String 
  
Chemin ="C:\Documents and Settings\michel\dossier\general\" 
Cible =Dir(Chemin ,16) 
  
If Cible <> "" Then 
	Do 
	  If Cible <>"." And Cible <>".." Then MsgBox Cible 
	  '".." et "." correspondent aux dossiers Parent et courant  
	  Cible =Dir 
	Loop Until Cible ="" 
End If 
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub listerRepertoires_V02 
Dim Chemin As String , NomObj As String 
Dim oSimpleFileAccess As Object 
Dim i As Integer  
Dim Tableau() 
  
Chemin ="C:\Documents and Settings\michel\dossier\general\" 
  
oSimpleFileAccess = CreateUnoService( "com.sun.star.ucb.SimpleFileAccess" )  
Tableau = oSimpleFileAccess.getFolderContents(ConvertToURL( Chemin ), True )  
  
For i = 1 To UBound(Tableau) + 1 
	NomObj = Tableau( i-1 )    
	If oSimpleFileAccess.isFolder( NomObj ) Then _ 
		MsgBox ConvertFromURL( NomObj )  
Next i 
End Sub

1
2
3
4
5
6
7
8
9
10
11
Sub VerifieExistenceRepertoire_V01 
Dim Chemin As String 
  
Chemin = "C:\Documents and Settings\michel\dossierOOo" 
  
If Dir(Chemin,vbDirectory) > "" then 
	MsgBox "Ce dossier existe." 
	Else 
	MsgBox "Ce dossier n'existe pas." 
End If 
End Sub

1
2
3
4
5
6
7
8
9
Sub VerifieExistenceRepertoire_V02 
Dim Dossier As String, urlDossier As String 
  
Dossier = "C:\Documents and Settings\michel\dossierOOo"  
  
urlDossier = ConvertToURL( Dossier ) 
'Renvoie False ou True  
MsgBox FileExists( urlDossier ) 
End Sub

1
2
3
4
5
Sub creerRepertoire 
'Crée un nouveau dossier nommé "DossierSauvegarde" 
'Les répertoires parents seront aussi créés s'ils n'existaient pas 
MkDir "C:\mon projet\DossierSauvegarde\Archives"  
End Sub

1
2
3
4
5
6
7
8
9
10
11
Sub selectionRepertoire  
Dim Dossier As Object  
Dim Valeur As Integer  
  
Dossier = _ 
  CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")  
Valeur = Dossier.Execute()  
  
If Valeur = 1 Then _ 
  MsgBox ConvertFromUrl(Dossier.getDirectory())  
End Sub

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
Sub lister_PathSettings  
Dim j As Integer , i As integer , x As Integer 
Dim oPathSettings As Object , objProprieteSetInfo As Object  
Dim Tableau() ,  TabChemin() 
Dim objPropriete As Object , Feuille As Object 
Dim ValPropriete As String , NomPropriete As String , Chemin As String 
  
oPathSettings = CreateUnoService( "com.sun.star.util.PathSettings" )  
  
objProprieteSetInfo = oPathSettings.getPropertySetInfo() 
'Transfert les données dans le tableau  
Tableau = objProprieteSetInfo.getProperties()  
  
'Spécifie la 1ere feuille du classeur 
Feuille = ThisComponent.Sheets(0) 
  
'Boucle sur le tableau pour extraire les résultats       
For i = LBound( Tableau ) To UBound( Tableau )  
	objPropriete = Tableau( i )  
	NomPropriete = objPropriete.Name  
	ValPropriete = oPathSettings.getPropertyValue( NomPropriete )  
	Feuille.getCellByPosition( 0 , x ).setString( NomPropriete ) 
  
	If Len( ValPropriete ) > 0 Then  
	  TabChemin = Split( ValPropriete, ";" )  
  
	  For j = LBound( TabChemin ) To UBound( TabChemin )  
	    Chemin = ConvertFromURL( TabChemin( j ))  
	    Feuille.getCellByPosition( 1 , x ).setString( NomPropriete & " : " & Chemin ) 
	    x = x + 1 
	  Next 
	End If  
  
	x = x + 1             
Next i  
End Sub

1
2
3
4
5
6
7
Sub ouvrirExplorateurWindows()  
Dim oShell As Object  
oShell = createUnoService("com.sun.star.system.SystemShellExecute")  
  
'La procédure renvoie un message d'erreur si le répertoire n'existe pas 
oShell.execute(ConvertToUrl("C:\Documents and Settings\michel\dossier"), "", 0)  
End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub CreerRaccourciBureau() 
  Dim WshShell As Object , Raccourci As Object 
  Dim dirBureau As String 
  
  oObj = createUnoService("com.sun.star.bridge.OleObjectFactory") 
  WshShell = oObj.createInstance("WScript.Shell") 
  dirBureau = Environ("USERPROFILE") & "\Bureau\" 'adaptez le chemin du bureau 
  
  Raccourci = WshShell.createShortcut( dirBureau & "monFichier.lnk") 
  
  Raccourci.TargetPath = ConvertFromURL( ThisComponent.Location ) 
  'Raccourci.IconLocation = "C:\dating.ico" 'Attribue un icône spécifique au raccourci 
  Raccourci.Save 
  
End Sub