1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. Visual Basic 6
Sujet Précédent Sujet Suivant

Vba chemin absolu chemin relatif

gwaheb Messages postés 9 Date d'inscription jeudi 15 mai 2008 Statut Membre Dernière intervention 18 juin 2011 - 10 juin 2011 à 14:41
gwaheb Messages postés 9 Date d'inscription jeudi 15 mai 2008 Statut Membre Dernière intervention 18 juin 2011 - 17 juin 2011 à 14:54
Bonjour je suis sur un projet sous access , mais j'ai du utilisé vba a un certain moment cela dis quand je change de machin il faut que je change de chemin
voila un exemple du programme

Option Compare Database

Private Sub Commande0_Click()

'Ici l'importation se déclenche en cliquant sur le bouton "Commande1"
'mais on peut aussi mettre ce code à l'ouverture d'un formulaire
Dim oApp 'As Excel.Application
Dim oWkb 'As Excel.Workbook
Dim oWSht 'As Excel.Worksheet

Set oApp = CreateObject("excel.application")

'Set oWkb = oApp.Workbooks.Open("chemin_du_fichier_xls") 'mettez ici le chemin vers votre fichier Excel
Set oWkb = oApp.Workbooks.Open("C:\Documents and Settings\Bureau\test import bdd\test.xls")

'Set oWSht = oWkb.Worksheets("nom_de_la_feuille_concernée_par_limportation") 'mettez ici le nom de la feuille qui contient les données à importer
Set oWSht = oWkb.Worksheets("Feuil1")

'première ligne ou commence l'import
i = 2

'pour éviter les messages lors de l'ajout des enregistrements
DoCmd.SetWarnings False

'tant qu'on n'est pas arrivés à la ligne 600 du tableur
While i < 10
'on peut aussi arrêter l'importation lorsque le programme rencontre une case
'vide en remplaçant la ligne du While par :
'While oWSht.Range("I" & i).Value <> "" '(où I représente la colonne et i la ligne)

'condition de remplissage de la table => eviter les doublons
'si l'enregistrement existe déjà dans la table destination,
'on passe à la ligne suivante sans l'importer
'If DCount("*", "[nom_da_la_table_destination]", "[nom_du_champ_destination_qui_ne_doit_pas_avoir_de_doublons] LIKE '" & oWSht.Cells(i, 9) & "'") = 0 Then
If DCount("*", "[Table1]", "[No] LIKE '" & oWSht.cells(i, 1) & "'") = 0 Then
'le numéro 9 correspond au numéro de la colonne source, tel que : A=1, B=2, C=3 ...

'requète SQL (avec en paramètre la ligne i et le numéro de la colonne comme précisé au-dessus)
'cSQL = "insert into [table_destination] ( [champ1], [champ2] ) values (" & Chr(34) & oWSht.Cells(i, 13) & Chr(34) & ", " & Chr(34) & oWSht.Cells(i, 11) & Chr(34) & ");"
cSQL = "insert into [Table1] ( [No], [Nom], [Prénom] ) values (" & Chr(34) & oWSht.cells(i, 1) & Chr(34) & ", " & Chr(34) & oWSht.cells(i, 2) & Chr(34) & ", " & Chr(34) & oWSht.cells(i, 3) & Chr(34) & ");"
'ici, on ne prend que les colonnes M (=13) et K (=11).

MsgBox (cSQL)

'exécute la requète
DoCmd.RunSQL cSQL

ElseIf DCount("*", "[Table1]", "[No] LIKE '" & oWSht.cells(i, 1) & "'") = 1 Then

cSQL = "update [Table1] set [Nom]=" & Chr(34) & oWSht.cells(i, 2) & Chr(34) & ", [Prénom]=" & Chr(34) & oWSht.cells(i, 3) & Chr(34) & " where [No]=" & oWSht.cells(i, 1) & ";"

MsgBox (cSQL)



'exécute la requète
DoCmd.RunSQL cSQL

Else

MsgBox ("Cas non prévu (clé primaire non unique)")

End If

'on incrémente la variable i pour passer à la ligne suivante
i = i + 1

Wend

'on réactive les messages d'erreurs
DoCmd.SetWarnings True
Set oWSht = Nothing
Set oWbk = Nothing
Set oApp = Nothing

End Sub


Donc ma question c'est comment faire pour qu'il n'ai qu'a cherche \test import bdd\test.xls ici ?

4 réponses

Réponse 1 / 4
SebSemos Messages postés 57 Date d'inscription mardi 24 mai 2011 Statut Membre Dernière intervention 13 juin 2011 1
10 juin 2011 à 15:18
Salut, regarde cette discussion elle devrais t'aider ;)


_______________________
Imports System.Thinking
'La vie Roxxx un max à qui s'en donne la peine
0
Réponse 2 / 4
ingito Messages postés 35 Date d'inscription vendredi 26 juin 2009 Statut Membre Dernière intervention 17 juin 2011
10 juin 2011 à 16:33
salut
si ton fichier est directement sur le bureau voila comment detecter le bureau de toute ordinateur
Set BRShell = CreateObject("WScript.Shell")
chemin = BRShell.SpecialFolders("Desktop")
si ton fichier est dans le repertoire de ton executable alors
chemin = ChDir(App.Path)
0
Réponse 3 / 4
c148270 Messages postés 303 Date d'inscription mercredi 12 janvier 2005 Statut Membre Dernière intervention 3 octobre 2013 1
11 juin 2011 à 01:41
Bonjour
Si tu connais le chemin tu peut utiliser INPUTBOX et saisir le chemein à l'invitation
Sinon ajoute le module de recherche suivant :

Public Fichiertrouve
'-----
Function Cherchefile()
retval = Cherchefichier("d:", "bd1.mdb")
If Fichiertrouve = True Then
a = 1
End If
End Function
'--------
Function Cherchefichier(ByRef strDir As String, ByRef searchTerm As String)
Dim fso As Object
Dim strName As String
Dim strArr(1 To 65536, 1 To 1) As String, i As Long
On Error GoTo errr
Fichiertrouve = False
Let strName = Dir$(strDir & "\*" & searchTerm)
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = strDir & "" & strName
Let strName = Dir$()
Loop
Set fso = CreateObject("Scripting.FileSystemObject")
Call recurseSubFolders(fso.GetFolder(strDir), strArr(), i, searchTerm)
Set fso = Nothing
If i > 0 Then
Fichiertrouve = True
a strArr(i, 1) 'pour mémoire : strArr chemin du fichier
End If
Exit Function
errr:
If Err.Number = 76 Then Resume Next ' répertoire inexistant
End Function
'--------------
Private Sub recurseSubFolders(ByRef Folder As Object, _
ByRef strArr() As String, _
ByRef i As Long, _
ByRef searchTerm As String)
Dim SubFolder As Object
Dim strName As String
On Error GoTo errr
For Each SubFolder In Folder.SubFolders
Let strName = Dir$(SubFolder.Path & "\*" & searchTerm)
Do While strName <> vbNullString
Let i = i + 1
Let strArr(i, 1) = SubFolder.Path & "" & strName
If Mid(strArr(i, 1), Len(strArr(i, 1)) - (Len(searchTerm) - 1), Len(searchTerm)) Then
a = strArr(i, 1)
End If
Loop
Call recurseSubFolders(SubFolder, strArr(), i, searchTerm)
Next
Exit Sub
errr:
If Err.Number 52 Then Resume Next '52 accès interdit
End Sub

bonne journée
0
Réponse 4 / 4
gwaheb Messages postés 9 Date d'inscription jeudi 15 mai 2008 Statut Membre Dernière intervention 18 juin 2011
17 juin 2011 à 14:54
il ya un autre probleme ma base de donné ne se met toujours pas a jour
quelqu'un pourrait il changerl e code que j'ai essayer de faire en tant que novice ? en la matiere ??
0
Rejoignez-nous