17-07-12, 13:18
|
| Διαχειριστής Όνομα: Τάσος Φιλοξενιδης Έκδοση λογισμικού Office: Ms-Office 365 Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική | | Εγγραφή: 21-10-2009
Μηνύματα: 2.011
| |
Καλησπέρα!
Δημήτρη, δοκίμασε τον παρακάτω κώδικα στη φόρμα σου (test).
Ο κώδικας αυτός λειτουργεί αυτόνομα (δεν εξαρτάται από τις συναρτήσεις των άλλων λειτουργικών μονάδων της εφαρμογής): Πρόσθεσε πρώτα την αναφορά Microsoft Scripting Runtime (Tools > References) Κώδικας: Option Compare Database
Option Explicit
Private Const strOpenTitle = "Εισαγωγή"
Private Const strDlgTitle = "Επιλογή αρχείου..."
Private Const DlgClass = "#32770"
Private Const SW_MAXIMIZE = 3&
Private Const SW_SHOWNORMAL = 1&
Private hw As Long
Private Const strFilter = "Όλα τα αρχεία (*.*)|Αρχεία Word (*.doc)|Αρχεία Excel (*.xls)|Αρχεία Pdf (*.pdf)|Αρχεία (*.rtf)"
Private Declare Function ShowWindow Lib "user32" (ByVal _
hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd _
As Long) As Long
Private fso As New Scripting.FileSystemObject
Private Function GetFilePath() As String
Dim strFile As String, strInitialDir As String
strInitialDir = CurrentProject.Path 'ή πχ. "C:\"
WizHook.Key = 51488399
Me.TimerInterval = 1000
WizHook.GetFileName 0, "", strDlgTitle, strOpenTitle, strFile, strInitialDir, strFilter, 0, 0, 64, True
GetFilePath = strFile
End Function
Private Sub Form_Timer()
If hw Then Me.TimerInterval = 0: hw = 0: Exit Sub
hw = FindWindow(DlgClass, strDlgTitle)
ShowWindow hw, SW_MAXIMIZE
End Sub
Private Sub cmdAddSmall_Click()
On Error GoTo cmdAddSmall_Err
Dim strFilename As String
strFilename = GetFilePath
If Len(strFilename) Then
Me![FilePath] = strFilename
Me.DocumentTitle = fso.GetFileName(strFilename)
Me.FolderName = fso.GetParentFolderName(strFilename)
End If
cmdAddSmall_End:
Exit Sub
cmdAddSmall_Err:
MsgBox Err & vbLf & Err.Description
Resume cmdAddSmall_End
End Sub
Private Sub cmdOpenWordDoc_Click()
Dim strFilename As String, lp_Directory As String
strFilename = Nz(Me.FilePath, "")
If Len(Trim(strFilename)) = 0 Then
MsgBox "Παρακαλώ βεβαιωθείτε ότι η διαδρομή για αυτό το έγγραφο είναι σωστή.", vbInformation, "Προσοχή!"
ElseIf Not fso.FileExists(strFilename) Then
MsgBox "Το έγγραφο δεν βρέθηκε." & vbCrLf & "Παρακαλώ αναζητήστετο ξανά.", vbExclamation, "Λυπάμαι!"
Else
lp_Directory = Nz(Me.FolderName, "")
If Not fso.FolderExists(lp_Directory) Then lp_Directory = "C:\"
ShellExecute 0, "open", strFilename, "", lp_Directory, SW_SHOWNORMAL
End If
End Sub
Φιλικά
Τάσος
__________________ Ms-Office Development Team Ανάπτυξη επαγγελματικών εφαρμογών
Τελευταία επεξεργασία από το χρήστη Tasos : 17-07-12 στις 13:28.
|