Cherche cador du VB Fermé

Question

Bonjour,

Je ne maitrise pas VB et pourtant il faut que je fasse un programme qui, lorsque je lui désigne un répertoire, passe en revue chaque fichier et l'enregistre dans une base de donnée.

Le programme serait du VB et j'utilise easyPHP pour la base.

Si vous avez une solution ou des conseils, surtout n'hésitez pas.

TUS

irem · Answer

peux-tu en dire plus, sur le papier c'est plutôt faisable, mais il faut quelques précisions :

VB : quelle version ?
MySQL : il faudra le nom de la base les identifiants de connexion et le modèle de données
Parser les fichiers : que faut-il mettre, le nom des fichiers ? ce qu'il y a dans les fichiers ? quel est le format desdits fichiers?

Irem

pharaon3 · Answer

merci de venir m'aider Irem

le nom de la table est B_photo (clés :  no_id 9N0; nom_photo 35A)
Cette table est liée à une autre B_dossier (clés : no_id 9N0; Typ_dossier 3A; nom_dossier 50A)

Il faut que je rajoute un test pour connaitre l'extension et si c'est du mpg ou jpeg... alors on créé directement dans la base les enregistremets.

Merci de d'être penché sur mon cas

irem · Answer

ok, si j'ai bien compris on met directement le fichier dans la base???

Mais dans quel version de VB exactement, VBScript, VB6, VB.Net????

Irem

pharaon3 · Answer

en effet le but est de sélectionné un répertoire
le pgm s'occupe d'intégrer les fichiers du répertoire en enregistrements sur la base
le pgm serait en VB6

pharaon3

irem · Answer

bon je vais etre tres sincere avec toi, VB6 c'est vieux pour moi , bref tu trouveras ci-dessous une souche a partir de laquelle tu devrais pouvoir te débrouiller désolé VERSION 5.00 Begin VB.Form Form1 Caption = "Form1" ClientHeight = 3090 ClientLeft = 60 ClientTop = 450 ClientWidth = 6240 LinkTopic = "Form1" ScaleHeight = 3090 ScaleWidth = 6240 StartUpPosition = 3 'Windows Default Begin VB.FileListBox File1 Height = 2625 Left = 360 TabIndex = 1 Top = 240 Width = 2055 End Begin VB.CommandButton Command1 Caption = "Command1" Height = 375 Left = 4440 TabIndex = 0 Top = 2040 Width = 1095 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '32-bit API declarations Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long Dim Connexion As ADODB.Connection Dim Rs As ADODB.Recordset Dim DataId As Integer Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Public Function MySQL_Conn(ByVal Server As String, ByVal Db As String, ByVal User As String, ByVal Pwd As String) As ADODB.Connection 'Connexion to the database Set MySQL_Conn = New ADODB.Connection MySQL_Conn.ConnectionString = "DRIVER={MySQL ODBC 3.51 Driver};" _ & "SERVER=" & Server & ";" _ & " DATABASE=" & Db & ";" _ & "UID=" & User & ";PWD=" & Pwd & "; OPTION=3" 'Open connexion MySQL_Conn.Open End Function Private Sub Form_Load() 'Open connexion a personnaliser Set Connexion = MySQL_Conn("localhost", "test", "root", "admin") 'Reload listview Set Rs = MySQL_Select(Connexion, "*", "NewTable", , , "id") RefreshList End Sub Private Sub Rs_close() 'Close recordset If Not (Rs Is Nothing) Then If Rs.State = 1 Then Rs.Close Set Rs = Nothing End If End Sub Public Sub MySQL_Insert(ByRef MySQL_Conn As ADODB.Connection, ByVal Table As String, ByVal Field1, Field2 As String, ByVal Value1, Value2 As String) 'Insert row MySQL_Conn.Execute "INSERT INTO `" & Table & "` (`" & Field1 & "`,`" & Field2 & "`) Values ('" & Value1 & "','" & Value2 & "')" End Sub Sub ListFiles() Dim msg As String, answer As String Dim Directory As String Dim R As Integer Dim i As Integer Dim StartDate As Single msg = "Select a location containing the files you want to list." Directory = GetDirectory(msg) If Directory = "" Then Exit Sub If Right(Directory, 1) <> "\" Then Directory = Directory & "\" File1.path = Directory For i = 1 To File1.ListCount ' mysql_insert mysql_conn,myTable,.... 'a modifier en fonction de ta table Next int_i End Sub Function GetDirectory(Optional msg) As String Dim bInfo As BROWSEINFO Dim path As String Dim R As Long, x As Long, pos As Integer ' Root folder = Desktop bInfo.pidlRoot = 0& ' Title in the dialog If IsMissing(msg) Then bInfo.lpszTitle = "Select a folder" Else bInfo.lpszTitle = msg End If ' Type of directory to return bInfo.ulFlags = &H1 ' Display the dialog x = SHBrowseForFolder(bInfo) ' Parse the result path = Space$(512) R = SHGetPathFromIDList(ByVal x, ByVal path) If R Then pos = InStr(path, Chr$(0)) GetDirectory = Left(path, pos - 1) Else GetDirectory = "" End If End Function Function InStrLast(iStart As Integer, szSrchIn As String, _ szSrchFor As String, iCompare As Integer) As Integer Dim iPrevFoundAt As Integer Dim iFoundAt As Integer On Error GoTo ErrExit_InStrLast iPrevFoundAt = 0 iFoundAt = InStr(iStart, szSrchIn, szSrchFor, iCompare) Do While iFoundAt > 0 iPrevFoundAt = iFoundAt iFoundAt = InStr(iPrevFoundAt + 1, szSrchIn, szSrchFor, iCompare) Loop ErrExit_InStrLast: If Err <> 0 Then MsgBox Error$, vbExclamation InStrLast = iPrevFoundAt Exit Function End Function Private Sub Command1_Click() ListFiles End Sub Irem

Cherche cador du VB

5 réponses

Discussions similaires

Newsletters