[RESOLU] ouvrir un dossier via un bouton

[lebanner]

bonjour a tous,

Est ce qu'il existe une fonction en Lotusscript ou en @formula permettant d'ouvrir un dossier (exemple : C:\TEMP) svp ?

Il y a la fonction @URLOpen qui permet d'ouvrir une URL mais je ne trouve pas le moyen d'ouvrir directement un dossier

Merci d'avance
Cordialement

[abertisch]

Salut,

Tu peux utiliser le lotusScript

Avec ce code tu peux ouvrir un dossier préci :

Code : Tout sélectionner

Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (hInstance As Long, Byval lpOperation As String, Byval lpFile As String, lpParameters As String, LpDirectory As String, nshowCmd As Integer) As Long

Call apiShellExecute(0, "Open", ton chemin vers le dossier, "", ton chemin vers le dossier, 1)


Sinon si tu veux ouvrir le dossier "temp" de windows tu peux utiliser ce code :

Code : Tout sélectionner

Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (Byval nBufferLength As Long, Byval lpBuffer As String) As Long

   Dim nSize As Long
   Dim tmp As String
   
   tmp = Space$(256)
   nSize = Len(tmp)
   Call GetTempPath(nSize, tmp)

Call apiShellExecute(0, "Open", tmp, "", tmp, 1)


[lebanner]

Salut,

Tu peux utiliser le lotusScript

Avec ce code tu peux ouvrir un dossier préci :

Code : Tout sélectionner

Declare Function ShellExecute Lib "Shell32.dll" Alias "ShellExecuteA" (hInstance As Long, Byval lpOperation As String, Byval lpFile As String, lpParameters As String, LpDirectory As String, nshowCmd As Integer) As Long

Call apiShellExecute(0, "Open", ton chemin vers le dossier, "", ton chemin vers le dossier, 1)


Sinon si tu veux ouvrir le dossier "temp" de windows tu peux utiliser ce code :

Code : Tout sélectionner

Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (Byval nBufferLength As Long, Byval lpBuffer As String) As Long

   Dim nSize As Long
   Dim tmp As String
   
   tmp = Space$(256)
   nSize = Len(tmp)
   Call GetTempPath(nSize, tmp)

Call apiShellExecute(0, "Open", tmp, "", tmp, 1)


Bonjour,

Je n'arrive pas à faire fonctionner ton code.
Est ce qu'il y a un moyen plus simple de le faire en Lotusscript voire même en @formula ?

Merci d'avance
Cordialement

[amahi]

@urlopen("file://c:\\tmp");

[Michael DELIQUE]

salut

une fonction qui le fait en LS

Code : Tout sélectionner

Public Sub WindowsOpenPath(wPath As String)

   Dim vrShell As Variant
   Dim Path As String
   
   On Error Goto CatchError
   
   Path = "C:\"
   
   If Trim(wPath)<>"" Then
      If DirectoryIsValide(Trim(wPath)) = True Then
         Path = Trim(wPath)
      End If
   End If
   
   Set vrShell = CreateObject("WScript.Shell")
   vrShell.Exec("explorer "+Path)
   Set vrShell = Nothing
   
   Exit Sub
CatchError:
   MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   Exit Sub
End Sub

[lebanner]

salut

une fonction qui le fait en LS

Code : Tout sélectionner

Public Sub WindowsOpenPath(wPath As String)

   Dim vrShell As Variant
   Dim Path As String
   
   On Error Goto CatchError
   
   Path = "C:\"
   
   If Trim(wPath)<>"" Then
      If DirectoryIsValide(Trim(wPath)) = True Then
         Path = Trim(wPath)
      End If
   End If
   
   Set vrShell = CreateObject("WScript.Shell")
   vrShell.Exec("explorer "+Path)
   Set vrShell = Nothing
   
   Exit Sub
CatchError:
   MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   Exit Sub
End Sub

Merci pour le code mais j'ai une petite erreur au niveau du "If" avec "DirectoryIsValide" :
WinowsOpenPath : 11 : Illegal parenthesized reference : DIRECTORYISVALIDE

Est ce que quelqu'un auait une idée pour résoudre ce problème svp ?

Merci d'avance
Cordialement

[Michael DELIQUE]

oups

il faut ajouter cette fonction

Code : Tout sélectionner

Public Function DirectoryIsValide(Byval wDirectory As String) As Boolean
   
   Dim Directory As String
   
   On Error Goto CatchError
   
   If wDirectory = "" Then
      DirectoryIsValide = False
      Exit Function
   End If
   
   If Right(Trim(wDirectory),1)="\" Then
      Directory = Left(Trim(wDirectory),Len(Trim(wDirectory))-1)
   Else
      Directory = Trim(wDirectory)
   End If
   
   On Error Resume Next
   If Trim(Dir$ (Directory,16))="" Then
      DirectoryIsValide = False
   Else
      DirectoryIsValide =True
   End If
   
   On Error Goto CatchError
   
   %REM   
      Dim Directory As String
      
      On Error Goto CatchError
      
      If wDirectory = "" Then
      DirectoryIsValide = False
      Exit Function
      End If
      
      If Right(Trim(wDirectory),1)="\" Then
      Directory = Left(Trim(wDirectory),Len(Trim(wDirectory))-1)
      Else
      Directory = Trim(wDirectory)
      End If
      
      If (Dir (Directory,16))="" Then
      DirectoryIsValide = False
      Else
      DirectoryIsValide =True
      End If
   %END REM   
   Exit Function
CatchError:
   MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   DirectoryIsValide = False
   Exit Function
End Function


[lebanner]

oups

il faut ajouter cette fonction

Code : Tout sélectionner

Public Function DirectoryIsValide(Byval wDirectory As String) As Boolean
   
   Dim Directory As String
   
   On Error Goto CatchError
   
   If wDirectory = "" Then
      DirectoryIsValide = False
      Exit Function
   End If
   
   If Right(Trim(wDirectory),1)="\" Then
      Directory = Left(Trim(wDirectory),Len(Trim(wDirectory))-1)
   Else
      Directory = Trim(wDirectory)
   End If
   
   On Error Resume Next
   If Trim(Dir$ (Directory,16))="" Then
      DirectoryIsValide = False
   Else
      DirectoryIsValide =True
   End If
   
   On Error Goto CatchError
   
   %REM   
      Dim Directory As String
      
      On Error Goto CatchError
      
      If wDirectory = "" Then
      DirectoryIsValide = False
      Exit Function
      End If
      
      If Right(Trim(wDirectory),1)="\" Then
      Directory = Left(Trim(wDirectory),Len(Trim(wDirectory))-1)
      Else
      Directory = Trim(wDirectory)
      End If
      
      If (Dir (Directory,16))="" Then
      DirectoryIsValide = False
      Else
      DirectoryIsValide =True
      End If
   %END REM   
   Exit Function
CatchError:
   MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
   DirectoryIsValide = False
   Exit Function
End Function


Ok, merci.
J'arrive à faire fonctionner le script, en démo il m'ouvre bien le dossier "TEMP".
Il reste juste un petit bug.
Quand je lcique pour la première fois sur le bouton, il m'ouvre bien le dossier "TEMP".
Par contre, si je tente de recliquer sur le bouton, il ne m'ouvre pas le dossier "TEMP", je ne comprend pas tout là !!

Comment est-ce possible ?
Merci
Cordialement

[lebanner]

Non, j'ai rien dis.
TOUT EST OK.

MERCI MICHAEL DELIQUE pour les fonctions

Cordialement