Sujet Précédent Sujet Suivant

VBA en VBS

olisab1 Messages postés 13 Date d'inscription dimanche 1 juillet 2007 Statut Membre Dernière intervention 4 juillet 2012 - 6 janv. 2008 à 14:19
olisab1 Messages postés 13 Date d'inscription dimanche 1 juillet 2007 Statut Membre Dernière intervention 4 juillet 2012 - 15 janv. 2008 à 22:09
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

Réponse 1 / 8
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 26
6 janv. 2008 à 21:54
 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
0
Réponse 2 / 8
olisab1 Messages postés 13 Date d'inscription dimanche 1 juillet 2007 Statut Membre Dernière intervention 4 juillet 2012
8 janv. 2008 à 21:17
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
0
Réponse 3 / 8
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 26
8 janv. 2008 à 21:50
 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
0
Réponse 4 / 8
olisab1 Messages postés 13 Date d'inscription dimanche 1 juillet 2007 Statut Membre Dernière intervention 4 juillet 2012
10 janv. 2008 à 20:25
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
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 8
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 26
10 janv. 2008 à 20:59
 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
0
Réponse 6 / 8
olisab1 Messages postés 13 Date d'inscription dimanche 1 juillet 2007 Statut Membre Dernière intervention 4 juillet 2012
11 janv. 2008 à 20:53
Bonsoir

Merci beaucoup pour le code

A bientot sur ce forum

Olivier
0
Réponse 7 / 8
cs_JMO Messages postés 1854 Date d'inscription jeudi 23 mai 2002 Statut Membre Dernière intervention 24 juin 2018 26
11 janv. 2008 à 21:04
Bonsoir olisab1,

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

@+ sur VBFrance.

jean-marc
0
Réponse 8 / 8
olisab1 Messages postés 13 Date d'inscription dimanche 1 juillet 2007 Statut Membre Dernière intervention 4 juillet 2012
15 janv. 2008 à 22:09
Bonsoir

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


Olivier
0

Discussions similaires

diferrence entre vba et vb.net,vb 6
mirmoleboss -
badrbadr -

5 réponses
**** Différence entre VB et VBA***********
EMSIEN -
CanisLupus -

3 réponses
transformer les fichiers .vbs en .exe
korbavc -
Nil -

3 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
A quoi sert la fonction Set ?
ICIoBRa -
ICIoBRa -

3 réponses
Rejoignez-nous