olisab1
Messages postés13Date d'inscriptiondimanche 1 juillet 2007StatutMembreDernière intervention 4 juillet 2012
-
6 janv. 2008 à 14:19
olisab1
Messages postés13Date d'inscriptiondimanche 1 juillet 2007StatutMembreDerniè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
cs_JMO
Messages postés1854Date d'inscriptionjeudi 23 mai 2002StatutMembreDernière intervention24 juin 201826 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
olisab1
Messages postés13Date d'inscriptiondimanche 1 juillet 2007StatutMembreDerniè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
cs_JMO
Messages postés1854Date d'inscriptionjeudi 23 mai 2002StatutMembreDernière intervention24 juin 201826 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