Cherche cador du VB
Fermé
pharaon3
Messages postés
3
Date d'inscription
lundi 13 février 2006
Statut
Membre
Dernière intervention
7 juin 2007
-
6 juin 2007 à 22:42
irem Messages postés 164 Date d'inscription mardi 22 mai 2007 Statut Membre Dernière intervention 9 octobre 2012 - 8 juin 2007 à 07:06
irem Messages postés 164 Date d'inscription mardi 22 mai 2007 Statut Membre Dernière intervention 9 octobre 2012 - 8 juin 2007 à 07:06
A voir également:
- Cherche cador du VB
- Vb - Télécharger - Langages
- Vb cable - Télécharger - Audio & Musique
- Vb download - Télécharger - Langages
- Vb runtime - Télécharger - Divers Utilitaires
- Vb 2008 - Télécharger - Langages
5 réponses
irem
Messages postés
164
Date d'inscription
mardi 22 mai 2007
Statut
Membre
Dernière intervention
9 octobre 2012
99
7 juin 2007 à 08:11
7 juin 2007 à 08:11
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
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
Messages postés
3
Date d'inscription
lundi 13 février 2006
Statut
Membre
Dernière intervention
7 juin 2007
7 juin 2007 à 14:11
7 juin 2007 à 14:11
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
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
Messages postés
164
Date d'inscription
mardi 22 mai 2007
Statut
Membre
Dernière intervention
9 octobre 2012
99
7 juin 2007 à 14:14
7 juin 2007 à 14:14
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
Mais dans quel version de VB exactement, VBScript, VB6, VB.Net????
Irem
pharaon3
Messages postés
3
Date d'inscription
lundi 13 février 2006
Statut
Membre
Dernière intervention
7 juin 2007
7 juin 2007 à 22:30
7 juin 2007 à 22:30
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
le pgm s'occupe d'intégrer les fichiers du répertoire en enregistrements sur la base
le pgm serait en VB6
pharaon3
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
irem
Messages postés
164
Date d'inscription
mardi 22 mai 2007
Statut
Membre
Dernière intervention
9 octobre 2012
99
8 juin 2007 à 07:06
8 juin 2007 à 07:06
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
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