Vba chemin absolu chemin relatif

Signaler
Messages postés
9
Date d'inscription
jeudi 15 mai 2008
Statut
Membre
Dernière intervention
18 juin 2011
-
gwaheb
Messages postés
9
Date d'inscription
jeudi 15 mai 2008
Statut
Membre
Dernière intervention
18 juin 2011
-
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

Messages postés
57
Date d'inscription
mardi 24 mai 2011
Statut
Membre
Dernière intervention
13 juin 2011
1
Salut, regarde cette discussion elle devrais t'aider ;)


_______________________
Imports System.Thinking
'La vie Roxxx un max à qui s'en donne la peine
Messages postés
35
Date d'inscription
vendredi 26 juin 2009
Statut
Membre
Dernière intervention
17 juin 2011

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)
Messages postés
303
Date d'inscription
mercredi 12 janvier 2005
Statut
Membre
Dernière intervention
3 octobre 2013

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
Messages postés
9
Date d'inscription
jeudi 15 mai 2008
Statut
Membre
Dernière intervention
18 juin 2011

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 ??