Print #1 / Nom ou numéro de fichier incorrect

Olic78124

Olic78124

XLDnaute Nouveau
Bonjour à toutes et à tous,

Tout est dans le titre, ou presque (voir code ci-dessous.

Je crée un fichier txt pour y mettre une liste d'erreur que j'exploite plus tard. La création se passe bien.
J'y écris 4 lignes (les 4 premiers Print #1 dans le code) et tout est OK je les retrouve bien dans le fichier.
Ensuite, à l'exploitation des données, je crée une ligne me donnant le numéro d'un demande lorsque cette dernière ne se trouve dans aucun onglet et c'est là que la problèmes commencent : je me prends un message "Erreur 52 : Nom ou numéro de fichier incorrect" (Print #1 au milieu du code) alors que le fichier txt est toujours ouvert
Même message en fin de Sub lorsque je veux écrire la bannière de fin de traitement dans le txt (les 4 Print #1 en fin de Sub)

J'utilise cette création/écriture/fermeture de fichier txt à tour de bras dans toutes les macros qui j'écris et je n'ai jamais rencontré ce genre d'erreur, une idée ?

D'avance merci et excellent réveillon à tout le monde.
Olivier

VB: 
Sub Recuperation_information()

Application.ScreenUpdating = False

' Déclaration des variables
Dim Onglet(30)
Dim FichierOuvert As String
Dim DernLigne As Integer
Dim NbOnglets As Integer
Dim NomOnglet As Variant
Dim Projet As String
Dim TableauCCS()
Dim NomMois As String, NomFichier As String, MonDossier As String

Set Principal = ActiveWorkbook
NbOnglets = 0

'=================================================================
' Modification 20191127 - Mise en place d'un fichier LOG
NomMois = Format(Date, "MMMMyyyy")
NomFichier = Format(Date, "yyyymmdd") & " - " & Format(Time, "hhmm")
MonDossier = "C:\User\" & Right(Application.UserName, 7) & "\Fichiers CdC\"
' Création du/des dossier(s) pour accueillir les fichiers de suivi/log
If Len(Dir(MonDossier, vbDirectory)) = 0 Then
    MkDir (MonDossier)
End If
MonDossier = MonDossier & NomMois & "\"
If Len(Dir(MonDossier, vbDirectory)) = 0 Then
    MkDir (MonDossier)
End If
MonDossier = MonDossier & "S" & Format(Date, "ww") & "\"
If Len(Dir(MonDossier, vbDirectory)) = 0 Then
    MkDir (MonDossier)
End If
'=================================================================

Open MonDossier & "Recup_Infos_" & NomFichier & ".txt" For Output As #1 ' Création du fichier LOG
Print #1, "================================================================================"
Print #1, "Erreurs rencontrées lors de la récupération des informations des CdC Spécifiques"
Print #1, "================================================================================"
Print #1, ""

Principal.Activate
ActiveWorkbook.Sheets("Admin").Activate

CCS = 2

While Cells(CCS, 11) = 1
    FichierOuvert = Cells(CCS, 10).Value & "_EVPH_deliverable_" & Cells(CCS, 9).Value & ".xlsm"
    Workbooks.Open Filename:="https://xxxxxxxxxxyyyyy/zzzzz/ref." & Cells(CCS, 10).Value & "/v.vc/" & FichierOuvert

' Activation du carnet de commande spécifique
    Workbooks(FichierOuvert).Activate
    ActiveWorkbook.Sheets("REQUEST").Activate
    TableauCCS = Range("A13:BR" & Range("C" & Rows.Count).End(xlUp).Row)
    For k = 1 To UBound(TableauCCS)

        If TableauCCS(k, 50) <> "Stopped" Or TableauCCS(k, 60) = "Accepted" Or TableauCCS(k, 60) = "Tacite" Then
' Activation du carnet de commande source
                Principal.Activate
                ActiveWorkbook.Sheets("CR").Activate
                NomOnglet = Application.VLookup(TableauCCS(k, 3), Range("C4:BZ" & Range("C" & Rows.Count).End(xlUp).Row), 76, False)
                If IsError(NomOnglet) Then
' Inscription de l'erreur dans le fichier LOG
                   [B][COLOR=rgb(226, 80, 65)] [/COLOR][/B]Print #1, "Erreur sur la demande " & TableauCCS(k, 3)
                    GoTo Erreur
                End If
                ActiveWorkbook.Sheets(NomOnglet).Activate
                NbLignes = Range("C" & Rows.Count).End(xlUp).Row
                For j = 13 To NbLignes
                    If Cells(j, 3) = TableauCCS(k, 3) Then

' Ligne de code / copies de données

                    End If
                Next j
Erreur:
'            Next sh
        End If
    Next k

' Fermeture sans sauvegarde du CdC Spécifique ouvert
    Workbooks.Item(FichierOuvert).Close savechanges:=False
    CCS = CCS + 1
    Principal.Activate
    ActiveWorkbook.Sheets("Admin").Activate
    Erase TableauCCS

Wend

Print #1, ""
Print #1, "=================================================="
Print #1, "Fin de la prodédure de récupération d'informations"
Print #1, "=================================================="

Close #1

Application.ScreenUpdating = True
        
End Sub
 
Trier par date Trier par votes
Olic78124

Olic78124

XLDnaute Nouveau
Bon ben j'ai résolu mon problème, attention il va falloir suivre hein... en replaçant

Open MonDossier & "Recup_Infos_" & NomFichier & ".txt" For Output As #1

par

Open MonDossier & "Recup_Infos_" & NomFichier & ".txt" For Output As #100

Bonne fin de journée.
Olivier
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
bonsoir
résolu de rien du tout
en fait ton "For Output As #1 " plante parce que cet index de fichier a deja éteé ouvert et non fermé donc cet index est indisponible
ET IL POURRAIT T ARRIVER LA MEME CHOSE AVEC 100 ,1000 , OU TOUT NOMBRE QUE TU METTRAIS
VBA a la fonction "freefile" interne pourquoi ne t'en sert tu pas
freefile te donne le 1 er index dispo

VB: 
dim X&
x=freefile
Open MonDossier & "Recup_Infos_" & NomFichier & ".txt" For Output As #x
'..
'...

et tu n'aura jamais de problème
;)
 
Vote positif 0 Vote négatif
dysorthographie

dysorthographie

XLDnaute Accro
bonsoir,
Code: 
'Permet de vérifier si le répertoire dont le nom est précisé en paramètre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe(Repertoires)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Repertoires_Existe = fso.FolderExists(Repertoires)
Set fso = Nothing
End Function
'Taille d'un répertoire
Public Function Taille_Repertoire(Repertoire)
Dim fso
Dim Rep
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Taille_Repertoire = Rep.Size
End Function
Function Repertoire_Date_Creation(Repertoire)
  Dim fso
Dim Rep
Set fso = CreateObject("Scripting.FileSystemObject")
    Set Rep = fso.GetFolder(Repertoire)
    Repertoire_Date_Creation = Rep.DateCreated
End Function
'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accès complet précisé en argument (NewRepertoires).
Public Sub Creer_Repertoires(NewRepertoires)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim t
Dim R
Dim I
R = ""
t = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(t) - 1
    If Trim("" & t(I)) <> "" Then
        R = R & Trim("" & t(I))
        If Repertoires_Existe(R) = False Then fso.CreateFolder "" & R
    End If
     R = R & "\"
Next
Set fso = Nothing
End Sub
'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
Public Sub Copie_Repertoires(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFolder Source, Destination, True
Set fso = Nothing
End Sub
'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
Public Function Deplace_Repertoire(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.MoveFolder Source, Destination
If Err > 0 Then Deplace_Repertoire = Err.Description
Err.Clear
On Error GoTo 0
Set fso = Nothing
End Function
'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
Public Sub Supprimer_Repertoire(DelRepertoire)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder DelRepertoire, True
Set fso = Nothing
End Sub
'Taille d'un répertoire
Public Function Taille_Fichier(Fichier)
Dim fso
Dim Fich
Set fso = CreateObject("Scripting.FileSystemObject")
Set Fich = fso.GetFile(Fichier)
    Taille_Fichier = Fich.Size
End Function
'Vérifie lexistance d'un   fichier
Public Function Fichier_Exist(Fichier)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Exist = fso.FileExists(Fichier)
Set fso = Nothing
End Function
'Retourne le nom du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_Name(Fichier)
Dim fso
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_Name = fso.GetBaseName(Fichier)
Set fso = Nothing
End If
End Function
'Retourne l'extension du fichier, à partir du chemin d'accès complet précisé en paramètre.
Public Function Fichier_extension(Fichier)
Dim fso
If Fichier_Exist(Fichier) = True Then
Set fso = CreateObject("Scripting.FileSystemObject")
Fichier_extension = fso.GetExtensionName(Fichier)
Set fso = Nothing
End If
End Function
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile Source, Destination, True
Set fso = Nothing
End Sub
'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
Public Sub Deplace_Fichier(Source, Destination)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile Source, Destination
Set fso = Nothing
End Sub
'Supprime le ou les fichiers dont le nom est précisé en argument.
Public Sub Supprimer_Fichier(DelFichier)
If Fichier_Exist(DelFichier) = True Then
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile DelFichier, True
Set fso = Nothing
End If
End Sub
Function AppendTxt(sFile, sText)
Dim fso, NewFichier
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(sFile, 8)
NewFichier.Write sText
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Function
Public Sub FichierLog(sFile, txt)
Dim FichierLog, fso
FichierLog = sFile
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(FichierLog) = False Then EnteteFichier FichierLog
AppendTxt FichierLog, txt
Set fso = Nothing
End Sub
Private Sub EnteteFichier(Fichier)
Dim txt, fso, NewFichier
txt = "***********************************************************************************************************************************************************************************"
txt = txt & vbCrLf
txt = txt & ""
txt = txt & vbCrLf
txt = txt & "   Date de création: " & Day(Now) & "/" & Month(Now) & "/" & Year(Now) & " " & Hour(Time) & ":" & Minute(Time) & vbCrLf
txt = txt & vbCrLf
txt = txt & "   " & Fichier
txt = txt & vbCrLf
txt = txt & "***********************************************************************************************************************************************************************************"
txt = txt & vbCrLf
txt = txt & vbCrLf
txt = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set NewFichier = fso.OpenTextFile(Fichier, 2, True)
NewFichier.Write txt
NewFichier.Close
Set NewFichier = Nothing
Set fso = Nothing
End Sub
Public Function OuvrirFichier(Fichier)
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(Fichier)
OuvrirFichier = Split(oFile.ReadAll, vbCrLf)
oFile.Close
End Function
Code: 
Sub test()
Dim win As New clsWindowsExporer, MonDossier As String, MonFichier As String
MonDossier = "c:\Myrep\TITI\": MonFichier = "MonDossier.txt"
win.Creer_Repertoires MonDossier

txt = "================================================================================" & vbCrLf
txt = txt & "Erreurs rencontrées lors de la récupération des informations des CdC Spécifiques" & vbCrLf
txt = txt & "================================================================================" & vbCrLf

win.FichierLog MonDossier & MonFichier, txt

win.FichierLog MonDossier & MonFichier, "Erreur sur la demande"


End Sub
 

Pièces jointes

  • Log.xlsm
    25.9 KB · Affichages: 3
Vote positif 0 Vote négatif
Olic78124

Olic78124

XLDnaute Nouveau
patricktoulon à dit:
re
bonsoir
résolu de rien du tout
en fait ton "For Output As #1 " plante parce que cet index de fichier a deja éteé ouvert et non fermé donc cet index est indisponible
ET IL POURRAIT T ARRIVER LA MEME CHOSE AVEC 100 ,1000 , OU TOUT NOMBRE QUE TU METTRAIS
VBA a la fonction "freefile" interne pourquoi ne t'en sert tu pas
freefile te donne le 1 er index dispo

VB: 
dim X&
x=freefile
Open MonDossier & "Recup_Infos_" & NomFichier & ".txt" For Output As #x
'..
'...

et tu n'aura jamais de problème
;)
Cliquez pour agrandir...
'jour,

Ben... je vais dire que non car le Open For Output fonctionne vu que j'arrive à écrire 4 lignes au tout début de la macro (les 4 Print qui se trouvent juste après le Open dans mon code) !

C'est une fois dans le déroulement de la macro, si erreur il y a, que le Print #1, "Erreur sur la demande"... plante !

Dans ta logique que je comprends tout à fait, si le Open For Output plantait, je ne pourrais pas écrire quoi que ce soit dans le fichier !?

@dysorthographie : merci pour cette lecture passionnante mais je ne comprends pas tout :)

Bonne journée au forum,
Olivier
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2016 Erreur d'execution '52': Nom ou numéro de fichier incorrect
Réponses
4
Affichages
528
macseb
M
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
200
Compte Supprimé 979
C
pmfontaine
  • Question
Microsoft 365 Erreur d'exécution 5 argument ou appel de procédure incorrect avec ActiveSheet.ChartObjects.Add()
Réponses
12
Affichages
388
pmfontaine
pmfontaine
C
  • Question
Microsoft 365 Créer dossiers, sous-dossiers et enregistrer sous OneDrive en ligne
Réponses
0
Affichages
160
Casim
C
C
  • Résolu(e)
XL 2021 Remplir données devis en vba avec descriptions/quantités/PUs alignés
2
Réponses
18
Affichages
433
Phil69970
Phil69970
F
  • Question
XL 2016 copier des fichiers dans des sous dossiers a partir de case a cocher sous excel
2
Réponses
17
Affichages
521
Felipe54
F
I
  • Question
Microsoft 365 Renommer des fichiers avec des caractères non reconnus
Réponses
10
Affichages
423
ivan27
I
M
  • Question
XL 2016 Impression d'un rapport PDF depuis une URL avec VBA
Réponses
3
Affichages
519
mrcooll
M
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
163
aziz
A
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
159
Francky79
F

Membres actuellement en ligne

8 membres et 58 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 047
Messages
2 084 864
Membres
102 688
dernier inscrit
Biquet78