Récupérer nom dossier

[rudymagny]

Bonsoir le forum,

Voilà je voudrais utiliser un code que j'ai trouvé sur excellabo mais je n'arrive pas à l'appliquer à mon cas:
Voilà j'ai un USF et lorque je clic sur un button j'appel ça:

Private Sub CommandButton1_Click()
WSName = ComboBox1.Value
If ComboBox1.Value = '' Then
Call MsgBox('Quelle feuille voulez vous éditer?', vbCritical, 'VCT-Essais E4[Erreur de Saisie]')
ComboBox1.SetFocus
Exit Sub
End If
If TextBox1 = 'Tableau_MOIS' Then
Call MsgBox('Veuillez changer le nom du fichier de sortie!', vbCritical, 'VCT-Essais E4[Erreur de Saisie]')
TextBox1.SetFocus
Exit Sub
End If
Sheets(WSName).Activate
Dim Fichier As String
nom = TextBox1.Value
GetDirectory
Fichier = Chemin & '\\' & nom & '.htm'
'testé avec Excel2002 & Excel2000
'code de MichelXLD sur forum XLD
'Fichier = 'D:\\RTE\\Travail\\Essais E4_VCT\\Nouvelle Organisation\\Indicateurs\\' & Nom & '.htm'
Fichier = 'K:\\Antenne Dispatching Regional\\2-Pole ID\\16- VCT - Essais E4\\Indicateurs\\' & nom & '.htm'
ActiveWorkbook.PublishObjects.Add(xlSourceSheet, Fichier, WSName, '', xlHtmlStatic, '', '').Publish
[TextBox1].Value = 'Tableau_MOIS'
ComboBox1.Value = ''
MsgBox ('Export HTML sous le répertoire K:\\Antenne Dispatching Regional\\2-Pole ID\\16- VCT - Essais E4\\Indicateurs\\' & nom & '.htm effectué!')
'Ouverture de l'explorateur windows dans le répertoire donné
ThisWorkbook.FollowHyperlink 'K:\\Antenne Dispatching Regional\\2-Pole ID\\16- VCT - Essais E4\\Indicateurs\\'
End Sub

et donc le module de excellabo 'getdirectory':

Public Chemin As String
Public 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
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib 'shell32.dll' _
Alias 'SHGetPathFromIDListA' (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib 'shell32.dll' _
Alias 'SHBrowseForFolderA' (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = 'Choisissez un dossier de destination pour les sauvegardes.'
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Chemin = GetDirectory & '\\'
Else
GetDirectory = ''
End If
End Function

le problème c'est qu'il bloque sur :
path = Space$(512)

et je ne vois po pourkoi?
j'espère être clair?

Merci d'avance

 

[MichelXld]

bonsoir

tu peux essayer

path = VBA.Space$(512)


bonne soirée
MichelXld

Message édité par: michelxld, à: 13/04/2006 19:55

 

[rudymagny]

Bonsoir MichelXLD!
Merci , c cool ça passe maintenant mais ça bloque autre part!
je regarde et si je bloque, j'enfais appel à vous!

Merci

 

[rudymagny]

ça y est un autre soucis:
il ne m'ouvre po l'eplorateur mais m'enregistre le fichier directment sous 'Mes documents':

Private Sub CommandButton1_Click()
WSName = ComboBox1.Value
If ComboBox1.Value = '' Then
Call MsgBox('Quelle feuille voulez vous éditer?', vbCritical, 'VCT-Essais E4[Erreur de Saisie]')
ComboBox1.SetFocus
Exit Sub
End If
If TextBox1 = '' Then
Call MsgBox('Veuillez changer le nom du fichier de sortie!', vbCritical, 'VCT-Essais E4[Erreur de Saisie]')
TextBox1.SetFocus
Exit Sub
End If
Sheets(WSName).Activate
Dim Fichier As String
nom = TextBox1.Value
Fichier = chemin & nom & '.htm'
'testé avec Excel2002 & Excel2000
'code de MichelXLD sur forum XLD
ActiveWorkbook.PublishObjects.Add(xlSourceSheet, Fichier, WSName, '', xlHtmlStatic, '', '').Publish
ComboBox1.Value = ''
End Sub

Public chemin As String
Public 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
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib 'shell32.dll' _
Alias 'SHGetPathFromIDListA' (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib 'shell32.dll' _
Alias 'SHBrowseForFolderA' (lpBrowseInfo As BROWSEINFO) As Long

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = 'Choisissez un dossier de destination pour les sauvegardes.'
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = VBA.Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
chemin = GetDirectory & '\\'
Else
GetDirectory = ''
End If
End Function

Je vois pas pourquoi, j'ai normalement bien appliquer le code? Nan

 

[rudymagny]

Le problème n'est plus celui là j'avais retirer l'appel de la fonction GetDirectory!
PFFFFFFF!

Enfin là il bloque sur le rouge:

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = 'Choisissez un dossier de destination pour les sauvegardes.'
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = VBA.Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
chemin = GetDirectory & '\\'
Else
GetDirectory = ''
End If
End Function

'Projet ou bibliothèque introuvable' ???
Je comprend pas

 

[MichelXld]

rebonsoir

as tu essayé la meme modification ?

pos = VBA.InStr(path, Chr$(0))


bonne soirée
MichelXld

 

[rudymagny]

j'avais essayé mais ça bloque tjrs sur:

pos = VBA.InStr(path, Chr$(0))

???

 

[MichelXld]

rebonsoir

par déduction ...

pos = VBA.InStr(path, VBA.Chr$(0))



bonne soirée
MichelXld

 

[rudymagny]

Au fait, quelle est la différence entre les codes si on rajout 'VBA. '

Merci

 

[rudymagny]

cette ligne passe quand je fais ça :
pos = InStr(path, VBA.Chr$(0))
mais ça bloque sur :

GetDirectory = Left(path, pos - 1)

 

[rudymagny]

Je ferais mieux d'attendre avant de poster, ça passe avec ça:

GetDirectory = VBA.Left(path, pos - 1)

 

[rudymagny]

Bon bah c nickel ça fonctionne!
impeccable!

Merci MichelXLD