VBA en VBS

Signaler
Messages postés
13
Date d'inscription
dimanche 1 juillet 2007
Statut
Membre
Dernière intervention
4 juillet 2012
-
Messages postés
13
Date d'inscription
dimanche 1 juillet 2007
Statut
Membre
Dernière intervention
4 juillet 2012
-
Bonjour

J'ai le code suivant qui fonctionne tres bien sous excel

J'aimerais savoir comment le faire tourner en vbs

Merci par avance

Private Sub Workbook_Open()

Application.OnTime Now + TimeValue("00:00:5"), "Quitter"
Chemin = "J:\sesame\remontees_standard\CE\mode_auto\*.txt"
Fich = Dir(Chemin)
SuiteFich:
NFich = "J:\sesame\remontees_standard\CE\mode_auto" & Fich
NFich1 = "J:\sesame\remontees_standard\CE\mode_auto" & Fich & "1"
DateFich = Mid(Fich, Len(Fich) - 18, Len(Fich) - 4)
Open NFich For Input As #1
Open NFich1 For Output As #2
Do While Not EOF(1)
Line Input #1, ligne

rem Remplacement des Noms Gex AutoIf Left(ligne, 7) "NOM_GEX" And (ligne Like "*1146797_ILOTA_MAUS1X*") Then ligne "NOM_GEX, 1146797_ILOTA_MAUS1XXX9P"If Left(ligne, 7) "NOM_GEX" And (ligne Like "*1146798_ILOTB_MAUS1X*") Then ligne "NOM_GEX, 1146798_ILOTB_MAUS1XXX9P"
If Left(ligne, 7) "NOM_GEX" And (ligne Like "*1146797_ilota_maus1x*") Then ligne "NOM_GEX, 1146797_ilota_maus1xxx9p"If Left(ligne, 7) "NOM_GEX" And (ligne Like "*1146798_ilotb_maus1x*") Then ligne "NOM_GEX, 1146798_ilotb_maus1xxx9p"
If Left(ligne, 8) "CODE_FON" And (ligne Like "*MS*") Then ligne "CODE_FON, MP"
 If Left(ligne, 8) "CODE_FON" And (ligne Like "*ms*") Then ligne "CODE_FON, mp"
 If Left(ligne, 7) "CRE_VER" And (ligne Like "**") Then ligne "CRE_VER, N"
 If Left(ligne, 9) "NOM_GAMME" And (ligne Like "*maus_xxxxxxx_ms_ce_xxxxx*") Then ligne "NOM_GAMME, maus_xxxxxxx_mp_ce_xxxxx"If Left(ligne, 9) "NOM_GAMME" And (ligne Like "*MAUS_XXXXXXX_MS_CE_XXXXX*") Then ligne "NOM_GAMME, MAUS_XXXXXXX_MP_CE_XXXXX"
 
 
Print #2, ligne
Loop
Close #1
Close #2
Fich = Dir
If Fich <> "" Then GoTo SuiteFich
 
Application.DisplayAlerts = False
Application.Quit
 
End Sub

8 réponses

Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 Bonsoir à tous,

La version vbs pourrait être

Option Explicit

MsgBox ShowFolderList("J:\sesame\remontees_standard\CE\mode_auto"),vbInformation,"Copie de Fichiers"

Function ShowFolderList(strPath) Const ForReading 1, ForWriting 2
Dim objFso, colFile, objTextStream, objTextFile
Dim strLine, imax, strListe
Set objFso = CreateObject("Scripting.FileSystemObject")
imax = 0

For Each colFile in objFso.GetFolder(strPath).Files
      
    If LCase(objFso.GetExtensionName(colFile)) = "txt" Then
       ReDim arrLines(0)
       Set objTextStream = objFso.OpenTextFile(colFile, ForReading)
      
       Do While Not objTextStream.AtEndOfStream
          strLine = objTextStream.ReadLine
          Select Case Left(strLine, 7)
            
             Case "NOM_GEX"
                If InStr(1, strLine, "1146797_ILOTA_MAUS1X") Then
                   Call WriteTab("NOM_GEX, 1146797_ILOTA_MAUS1XXX9P", arrLines)
                ElseIf InStr(1, strLine, "1146798_ILOTB_MAUS1X") Then
                   Call WriteTab("NOM_GEX, 1146798_ILOTB_MAUS1XXX9P", arrLines) 
                ElseIf InStr(1, strLine, "1146797_ilota_maus1x") Then
                   Call WriteTab("NOM_GEX, 1146797_ilota_maus1xxx9p", arrLines)
                ElseIf InStr(1, strLine, "1146798_ilotb_maus1xxx9p") Then
                   Call WriteTab("NOM_GEX, 1146798_ilotb_maus1xxx9p", arrLines)                 
                End If
            
             Case "CODE_FO"
                If InStr(1, strLine, "MS") Then
                   Call WriteTab("CODE_FON, MP", arrLines)
                ElseIf InStr(1, strLine, "ms") Then
                   Call WriteTab("CODE_FON, mp", arrLines) 
                End If
            
             Case "CRE_VER"
                If InStr(1, strLine, "**") Then
                   Call WriteTab("CRE_VER, N", arrLines)
                End If             
            
             Case "NOM_GAM"
                If InStr(1, strLine, "MAUS_XXXXXXX_MS_CE_XXXXX") Then
                   Call WriteTab("NOM_GAMME, MAUS_XXXXXXX_MP_CE_XXXXX", arrLines)
                ElseIf InStr(1, strLine, "maus_xxxxxxx_ms_ce_xxxxx") Then
                   Call WriteTab("NOM_GAMME, maus_xxxxxxx_mp_ce_xxxxx", arrLines) 
                End If             
         
          End Select
       Loop
       objTextStream.Close 
      
       'Ecriture dans nouveau fichier
       If Ubound(arrLines) <> 0 Then
          colFile = objFso.GetParentFolderName(colFile) & "" & _
                    objFso.GetBaseName(colFile) & "_new." & _
                    objFso.GetExtensionName(colFile)
          strListe = strListe &vbcrlf& colFile
          Set objTextFile = objFso.CreateTextFile(colFile, ForWriting)
          Dim i
          For i = 0 to Ubound(arrLines)-1  
              objTextFile.Write arrLines(i) &vbCrLf
          Next
          objTextFile.Close    
       End If  
   End if
Next
ShowFolderList = "Fichiers créés" &vbCrLf&vbCrLf& strListe
Set objTextStream = Nothing
Set objTextFile = Nothing
Set objFso = Nothing
End Function

Function WriteTab(strLine, arrLines)
    arrLines(UBound(arrLines)) = strLine
    ReDim Preserve arrLines(UBound(arrLines) + 1)
End Function

jean-marc
Messages postés
13
Date d'inscription
dimanche 1 juillet 2007
Statut
Membre
Dernière intervention
4 juillet 2012

Bonsoir

J'ai essaye le code mais comment faire pour qu'il reprenne la totalite du fichier
txt existant en changeant les lignes que je veux et le renommer en txt1

Merci pour votre aide

Olivier
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 Bonsoir,

Quelques ajouts de  Call WriteTab(strLine, arrLines)  et :

          Select Case Left(strLine, 7)
            
             Case "NOM_GEX"
                If InStr(1, strLine, "1146797_ILOTA_MAUS1X") Then
                   Call WriteTab("NOM_GEX, 1146797_ILOTA_MAUS1XXX9P", arrLines)
                ElseIf InStr(1, strLine, "1146798_ILOTB_MAUS1X") Then
                   Call WriteTab("NOM_GEX, 1146798_ILOTB_MAUS1XXX9P", arrLines) 
                ElseIf InStr(1, strLine, "1146797_ilota_maus1x") Then
                   Call WriteTab("NOM_GEX, 1146797_ilota_maus1xxx9p", arrLines)
                ElseIf InStr(1, strLine, "1146798_ilotb_maus1xxx9p") Then
                   Call WriteTab("NOM_GEX, 1146798_ilotb_maus1xxx9p", arrLines)
                Else
                   Call WriteTab(strLine, arrLines)             
                End If
            
             Case "CODE_FO"
                If InStr(1, strLine, "MS") Then
                   Call WriteTab("CODE_FON, MP", arrLines)
                ElseIf InStr(1, strLine, "ms") Then
                   Call WriteTab("CODE_FON, mp", arrLines) 
                Else
                   Call WriteTab(strLine, arrLines)
                End If
            
             Case "CRE_VER"
                If InStr(1, strLine, "**") Then
                   Call WriteTab("CRE_VER, N", arrLines)
                   Else
                   Call WriteTab(strLine, arrLines)
                End If             
            
             Case "NOM_GAM"
                If InStr(1, strLine, "MAUS_XXXXXXX_MS_CE_XXXXX") Then
                   Call WriteTab("NOM_GAMME, MAUS_XXXXXXX_MP_CE_XXXXX", arrLines)
                ElseIf InStr(1, strLine, "maus_xxxxxxx_ms_ce_xxxxx") Then
                   Call WriteTab("NOM_GAMME, maus_xxxxxxx_mp_ce_xxxxx", arrLines)
                Else
                   Call WriteTab(strLine, arrLines)
                End If             
             Case Else
                   Call WriteTab(strLine, arrLines)
          End Select

jean-marc
Messages postés
13
Date d'inscription
dimanche 1 juillet 2007
Statut
Membre
Dernière intervention
4 juillet 2012

Bonsoir

Merci beaucoup pour le code
ca marche nikel
mais je vais abuser encore un peu

Est -il possible de renommer le fichier en extension txt1
a la place de new.txt

Merci
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
 Bonsoir olisab1,

      'Ecriture dans nouveau fichier
       If Ubound(arrLines) <> 0 Then
          colFile = objFso.GetParentFolderName(colFile) & "" & _
                    objFso.GetBaseName(colFile) & "." & _
                    objFso.GetExtensionName(colFile) & "1"

objFso.GetExtensionName(colFile) & "1" ouobjFso.GetExtensionName(colFile) & 1
les 2 syntaxes sont acceptées.

jean-marc
Messages postés
13
Date d'inscription
dimanche 1 juillet 2007
Statut
Membre
Dernière intervention
4 juillet 2012

Bonsoir

Merci beaucoup pour le code

A bientot sur ce forum

Olivier
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
26
Bonsoir olisab1,

Merci à l'occasion de cloturer ce post en validant la proposition qui t'a le plus aidé.

@+ sur VBFrance.

jean-marc
Messages postés
13
Date d'inscription
dimanche 1 juillet 2007
Statut
Membre
Dernière intervention
4 juillet 2012

Bonsoir

Le post qui m'a le plus aide est sans aucun doute le premier
Encore merci


Olivier