'on coupe la cellule ou le string mot par mot, séparés par une virgule
Arr = Split(CellB, ",")
output = ""
'Puis pour chaque élément du tableau
For b = 0 To UBound(Arr)
If IsEmpty(Arr(b)) = False Then
String = Arr(b)
ensuite on en fait ce qu'on veux, on l'affiche, on le garde, on le parse ou on les écrit dans un fichier
msgbox(String)
StringFormate = ("[[" & String & "]]")
file.Write StringFormate & vbCrLf
file.Close
Next b
Exemple pour remplacer des caractères d'un string :
String = Cell.Value
String = Replace(String, "/", "_")
String = Replace(String, "", "_")
String = Replace(String, ":", "_")
String = Replace(String, "?", "_")
String = Replace(String, "<", "_")
String = Replace(String, ">", "_")
String = Replace(String, "|", "_")
String = Replace(String, "é", "e")
String = Replace(String, "è", "e")
String = Replace(String, "à", "a")
CheminGeneral = "S:Nomdossier"
Dim fso, file
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Dim i
i = 0
Dim CellB As String
'Pour chaque cellule dans le classeur "NomClasseur" dans la colone A
For Each Cell In Sheets("NomClasseur").UsedRange.Columns("A").Cells
'Compteur pour utiliser récupérer la cellule colonne B correspondante
i = i + 1
'Si la cellule n'est pas vide et ne contient pas le titre ; attention la cellule n'est pas forcément considérée comme vide, dans ce cas faire un (if not cell.value = "")
If IsEmpty(Cell.Value) = False And Cell.Value <> "Titre" Then
'celluleB = ligne compteur, colone2
CellB = Sheets("NomClasseur").Cells(i, 2).Value
On peut par exemple reformer le contenu dans une variable, ici pour de la création de fichier qui n’acceptera pas ces caractères :
FindString = Cell.Value
FindString = Replace(FindString, "/", "_")
FindString = Replace(FindString, "", "_")
FindString = Replace(FindString, ":", "_")
FindString = Replace(FindString, "?", "_")
FindString = Replace(FindString, "<", "_")
FindString = Replace(FindString, ">", "_")
FindString = Replace(FindString, "|", "_")
FindString = Replace(FindString, "é", "e")
FindString = Replace(FindString, "è", "e")
FindString = Replace(FindString, "à", "a")
'On test si le fichier n'existe pas déjà, ici pour de la création de fichier markdown
Dim strFileName As String
Dim strFileExists As String
strFileName = (CheminGeneral & "NomDossier" & FindString & ".md")
strFileExists = Dir(strFileName)
If strFileExists = "" Then
On crée le fichier MarkDown au nom du string formaté car il n'existe pas
Emplacement = (CheminGeneral & "NomDossier" & FindString & ".md")
Set file = fso.OpenTextFile(Emplacement, ForWriting, True)
Puis on peut par exemple écrire un contenu dans le fichier
file.Write "Mon Contenu" & vbCrLf
file.Close
Else
' le fichier de brique existe déjà
End If
On défini les variables
CheminGeneral = "R:'Dossier"
Dim fso, file
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Puis création des dossiers, seulement s'ils n'existent pas déjà :
Dim sFolderPath As String
sFolderPath = (CheminGeneral & "NomDossier")
If Right(sFolderPath, 1) <> "" Then
sFolderPath = sFolderPath & ""
End If
If Dir(sFolderPath, vbDirectory) <> vbNullString Then
' MsgBox "Folder exist", vbInformation, "NomDossier"
Else
'MsgBox "Folder doesn't exist", vbInformation, "NomDossier"
MkDir (CheminGeneral & "NomDossier")
End If
Exemple pour la suppression de fichiers excel dans un dossier si existants
'On déclare le dossier et le type de fichier
directory = "CheminRéseauDossier"
Set obj = CreateObject("Scripting.FileSystemObject")
fileName = Dir(directory & "*.xl??")
Puis on supprime l'objet s'il existe
If obj.FileExists(directory & fileName) Then
obj.DeleteFile (directory & fileName)
MsgBox ("Le fichier a ete supprime")