Création d'un fichier fictif

[zenico64]

Bonjour à tous.

J'ai fais une macro en VBA qui permet de créer un fichier puis de le supprimer.

entre temps, le fichier est envoyé sur un serveur FTP.

Voici le code:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
 
'-------------------
'Déclaration des API
'-------------------
Private Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
 
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
(ByVal hInternetSession As Long, ByVal sServerName As String, _
ByVal nServerPort As Integer, _
ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
 
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
 
Private Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
"FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
 
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hConnect As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
ByRef dwContext As Long) As Boolean
 
Private Declare Function FtpPutFile Lib "wininet.dll" Alias _
"FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, _
ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean
 
 
'A la fermeture de Outlook
Private Sub Application_Quit()
 
'Activer la référece Microsoft Scripting Runtime dans Outils/référence
 
On Error Resume Next
 
Dim path As String
Dim nom As String
Dim entreprise As String
 
nom = "Nicolas VIOT"
entreprise = "Fonderie Messier"
path = app.path
 
Dim objNS As Outlook.NameSpace
Dim objAppointments As Outlook.Items, objCalendarFolder As Outlook.MAPIFolder
Dim objAppointment As Outlook.AppointmentItem
Dim objFS As Scripting.FileSystemObject, objOutputFile As Scripting.TextStream
'Déclaration des variables pour l'envoi par FTP
Dim HwndConnect As Long
Dim HwndOpen As Long
 
Set objNS = Application.GetNamespace("MAPI")
Set objCalendarFolder = objNS.GetDefaultFolder(olFolderCalendar)
Set objAppointments = objCalendarFolder.Items
 
Set objFS = New Scripting.FileSystemObject
Set objOutputFile = objFS.CreateTextFile(path & "AgendaExport.csv", True)
 
'Write header line
objOutputFile.WriteLine nom & "," & entreprise & path
 
For Each objAppointment In objAppointments
If DateValue(objAppointment.Start) >= Date And DateValue(objAppointment.Start) <= DateSerial(DatePart("yyyy", Now), DatePart("m", Now) + 3, DatePart("d", Now)) Then
objOutputFile.WriteLine """ "",""" & DateValue(objAppointment.Start) & """,""" & TimeValue(objAppointment.Start) & """,""" & DateValue(objAppointment.End) & """,""" & TimeValue(objAppointment.End) & """,""" & objAppointment.AllDayEvent & ""","""
End If
Next
objOutputFile.Close
 
'J'ajoute le fichier sur le serveur FTP'***********************************************************
'ouverture internet
HwndOpen = InternetOpen("calendrier.ventana-aerospace.fr", 0, vbNullString, vbNullString, 0)
'Connection au site ftp
HwndConnect = InternetConnect(HwndOpen, "calendrier.ventana-aerospace.fr", 21, "user", "mdp", 1, 0, 0)
'positionnement du curseur dans le répertoire
FtpSetCurrentDirectory HwndConnect, "/httpdocs/FTP_content"
'envoi du fichier sur le Site FTP
FtpPutFile HwndConnect, path & "AgendaExport.csv", "Agenda_" & Replace(nom, " ", "_") & ".csv", &H0, 0
 
InternetCloseHandle HwndConnect 'Ferme la connection
InternetCloseHandle HwndOpen 'Ferme internet
'*****************************************************************************************************************
 
'Destruction du fichier
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile (path & "AgendaExport.csv")
 
Set objNS = Nothing
Set objAppointment = Nothing
Set objAppointments = Nothing
Set objCalendarFolder = Nothing
Set objFS = Nothing
Set objOutputFile = Nothing
 
End Sub

Je me demandais s'il était possible de faire la même chose mais en créant ce fichier, non pas sur le DD en physique, mais juste en mémoire histoire de ne pas avoir un répertoire juste pour la création d'un fichier pendant 2 seconde.

Si vous avez une idée, je suis preneur.

Moi je cherche

J'en profite aussi pour demander comment marche App.Path car chez moi, il ne renvoi rien. Pire encore, si je met path = App.Path & "blabla" la variable path contient "".

Voilà.

[helas]

Bonjour,
Choisir path comme nom de variable n'est pas judicieux, dossier ou repertoire ne rentreraient pas en conflit avec la fonction Path
app ne se rapportant à rien, le dossier est null, c'est normal et Null & "blabla" reste Null
Le fichier pourrait être créé sur un disque virtuel mais c'est bien compliqué pour si peu
Tout simplement pourquoi ne pas définir
dossier = "C:\"
et supprimer le fichier en fin d'utilisation par un Kill "C:\nomfichier.csv"