Solved

open a MPEG file with a button click

Posted on 2004-09-30
21
183 Views
Last Modified: 2010-05-02
I need to open a .MPEG file onClick of a button in a VB form - nothing special, no detection of software, just as if the user double clicked on it from explorer.  How can i do this?


/.nick
0
Comment
Question by:Anjinsan5
  • 13
  • 8
21 Comments
 
LVL 32

Expert Comment

by:Erick37
ID: 12194451
You can use the ShellExecute API to run the program on your computer which is associated with MPEG files.

Call it like this:

Call RunAssociatedFile("C:\wow.mpeg")

'~~~~~~~~Form Code~~~~~~~~~

Private Declare Function GetDesktopWindow Lib "user32" () 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 Const SW_SHOWNORMAL = 1


Public Function RunAssociatedFile(ByVal strDocName As String) As Long
    Dim Scr_hDC As Long
    Dim lngRes As Long
    Scr_hDC = GetDesktopWindow()
    RunAssociatedFile = ShellExecute(Scr_hDC, "Open", strDocName, "", "C:\", SW_SHOWNORMAL)
End Function
0
 

Author Comment

by:Anjinsan5
ID: 12194478
do i need to include any files in the project to make this run properly? (i'm not exactly an experienced VB person)
0
 

Author Comment

by:Anjinsan5
ID: 12194545
This doesn't seem to have any affect - nothing happens onclick of the button - i just need windows media player (or whatever the system plays mpegs with) to open and run the file - just like a double click would do.

/.nick
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12194644
In your button click event:

Private Sub Command1_Click()
   
    Dim sFile as String

    sFile = "c:\thepathtoyourfile\thefile.mpeg" '<<< This must be a valid path + filename

    Call RunAssociatedFile(sFile)

End Sub
0
 

Author Comment

by:Anjinsan5
ID: 12199961
The button still does nothing - i'm trying to burn this onto a CD, and i know i've got the logical path right.

Still unsure why i can't get this event to run.  Basically it's acting like when it can't find the file.
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12200146
You can use the return value from the function to tell if an error occurred.  Try this and see if it gives you a message:

Private Sub Command1_Click()
   
    Dim sFile As String
    Dim r As Long
    Dim msg As String

    sFile = "c:\thepathtoyourfile\thefile.mpeg" '<<< This must be a valid path + filename

    r = RunAssociatedFile(sFile)
   
    Select Case r
    Case 2: msg = "File not found"
    Case 3: msg = "Path not found"
    Case 5: msg = "Access denied"
    Case 8: msg = "Out of memory"
    Case 32: msg = "DLL not found"
    Case 26: msg = "A sharing violation occurred"
    Case 27: msg = "Incomplete or invalid file association"
    Case 28: msg = "DDE Time out"
    Case 29: msg = "DDE transaction failed"
    Case 30: msg = "DDE busy"
    Case 31: msg = "No association for file extension"
    Case 11: msg = "Invalid EXE file or error in EXE image"
    Case Else: msg = "Unknown error"
    End Select
   
    If r > 0 Then MsgBox msg

End Sub
0
 

Author Comment

by:Anjinsan5
ID: 12200231
Here's the 2 things that i'm trying to use to make this happen:

'Here's the button onclick sub routine:

Private Sub imgMV3Vid_Click()
    Call playSound(App.Path & "\Media\blip.wav")
    Dim sFile As String
    sFile = "\extras\video\mv3.mpg" '<<< This must be a valid path + filename
    Call RunAssociatedFile(sFile)
End Sub

'Here's the function - not sure about the parameters in my ShellExecute command - can i get some help there?

Public Function RunAssociatedFile(ByVal strDocName As String) As Long
    Dim Scr_hDC As Long
    Dim lngRes As Long
    Scr_hDC = GetDesktopWindow()
    RunAssociatedFile = ShellExecute(Scr_hDC, "Open", strDocName, "", "\", SW_SHOWNORMAL)
End Function

Should this work?  Everything is being kept as logical paths because this will be burned onto a cd with the .mpg file located @ /extras/video/mv3.mpg
0
 

Author Comment

by:Anjinsan5
ID: 12200259
ok - tried the error check routine - gives me a file not found error
0
 

Author Comment

by:Anjinsan5
ID: 12200279
and i know for a fact that from the project folder the video IS @ \extras\video\mv3.mpg
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12200400
Try giving the string the FULL path, not a relative path.
sFile = "c:\the full path\extras\video\mv3.mpg"
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:Anjinsan5
ID: 12200851
well what if it's on a CD?  I can't just hard code a drive letter.
0
 

Author Comment

by:Anjinsan5
ID: 12200892
ok well when i use the WHOLE path it works just fine.....how can i avoid having to hard code something that will change with each system it's on (potentially)
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12201231
You will have to build the path during runtime.

e.g.

If the file is in your applications path:

Dim sPath as string
Dim sFile as string

sPath = App.Path & "\"
sFile = "hello.mpg"

r = RunAssociatedFile(sPath & sFile)

If the file is on a CD, then you will have to search for it in the available CD drives, then place the path in sPath.
There may be multiple CD drives on the computer, so it may be tricky.

This code sample will determine the CD drives on a computer:

How To Use Visual Basic to Locate CD-ROM Drives
http://support.microsoft.com/support/kb/articles/Q291/5/75.ASP
0
 

Author Comment

by:Anjinsan5
ID: 12201909
Ok - working on trying that last one - but will you tell me why the following doesn't work unless the CD is in drive D:?  I know that the variable "justonedrive$" is set to D:\ on my system because i put in a break point - so it seems to detect it but only on my system - when i put it in a computer with drive F:, it didn't work!

Private Sub imgMV3Vid_Click()
    Call playSound(App.Path & "\Media\blip.wav")
    Dim sFile As String
    Dim msg As String
    Dim r&, allDrives$, justonedrive$, pos%, DriveType&
    Dim CDfound As Integer

'Note: some of this code was taken from assistance given by experts @ experts-exchange.com
'view http://www.experts-exchange.com/Programming/Programming_Languages/Visual_Basic/Q_21128712.html for details
'----------------------------------------------------------------------------------------------------------------
  'pad the string with spaces
   allDrives$ = Space$(64)

  'call the API to get the string containing all drives
   r& = GetLogicalDriveStrings(Len(allDrives$), allDrives$)

  'trim off trailing chr$(0)'s.  AllDrives$
  'now contains all the drive letters.
   allDrives$ = Left$(allDrives$, r&)

  'begin a loop
   Do

     'find the first separating chr$(0)
      pos% = InStr(allDrives$, Chr$(0))

     'if there's one, then...
      If pos% Then

       'extract the drive up to the chr$(0)
        justonedrive$ = Left$(allDrives$, pos%)

       'and remove that from the Alldrives string,
       'so it won't be checked again
        allDrives$ = Mid$(allDrives$, pos% + 1, Len(allDrives$))

       'with the one drive, call the API to
       'determine the drive type
        DriveType& = GetDriveType(justonedrive$)

       'check if it's what we want
        If DriveType& = DRIVE_CDROM Then

          'got it (or at least the first one,
          'anyway, if more than one), so set
          'the found flag...
           CDfound% = True

          'we're done, so get out
           Exit Do

        End If
      End If
    Loop Until allDrives$ = "" Or DriveType& = DRIVE_CDROM
    justonedrive$ = Left(justonedrive$, 3)
    sFile = justonedrive$ & "extras\video\mv3.mpg"
    Call RunAssociatedFile(sFile)

End Sub
0
 

Author Comment

by:Anjinsan5
ID: 12202181
ok - tried to implement the MS solution to CDRom detection - didn't work at all.  The function detects the Z:\ drive on my system EVERY TIME!!  THis is a networked drive, not a CDRom!!

HELP!!
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12202311
If I understand correctly, the code works for you in your computer with the CD in drive D:.

It does not work in a computer where the CD drive is in drive F:?

The code you are using exits with the first CD drive it finds.  If the computer has 2 or more CD drives, (Drive E: and Drive F: for example) then the code above will return only E:.  So it will not work if you happen to put the CD in drive F: in this example.
0
 

Author Comment

by:Anjinsan5
ID: 12202387
ok - sorry to jump to conclusions on my programming ability - i didn't see that the MS solution will detect the drive, but doesn't stop the loop once it finds it - hence the Z:\ drive (last one) was selected.

Now my problem is this: multi CDRom systems - when i use the current code, I jump out of the loop once it finds A CDRom drive, but i really need it to jump out once it gets to THE CDRom drive that the CD is in.

Almost there!
0
 

Author Comment

by:Anjinsan5
ID: 12202992
I simply need to detect which drive actually contains the CD - right now it just finds the first one (by drive letter alphabetically), and uses that info - how can i detect if it's the drive that the program is actually running from?
0
 
LVL 32

Accepted Solution

by:
Erick37 earned 500 total points
ID: 12203138
Try this.  It uses a function called FileExists to determine if the file is found when searching all the CD_ROM drives.

~~~~~~~~~~Form Code~~~~~~~~~~

Option Explicit

Private Sub Command1_Click()
    Dim strDrives As String
    Dim sFile As String
    Dim pos As Long
    Dim drive As String
    Dim drivetype As Long
    Dim r As Long
    Dim msg As String
   
    ' Find out what drives we have on this machine
    strDrives = GetDriveStrings()
   
    If strDrives = "" Then
        ' No drives were found
        Debug.Print "No Drives were found!"
        Exit Sub
    Else
        ' Walk through the string and check the type of each drive
        ' displaying any cd-rom drives we find
       
       
        pos = 1
       
        Do While Not Mid$(strDrives, pos, 1) = Chr(0)
            drive = Mid$(strDrives, pos, 3)
            pos = pos + 4
            drivetype = GetDriveType(drive)
            If drivetype = DRIVE_CDROM Then
                'MsgBox "CD-ROM found at drive " & UCase(drive)
                'Found a CD-ROM drive, check for the file
                sFile = drive & "extras\video\mv3.mpg"
               
                Debug.Print sFile
               
                If FileExists(sFile) Then
               
                    r = RunAssociatedFile(sFile)
       
                    Select Case r
                    Case 0: msg = "System Memory Too Low"
                    Case 2: msg = "File not found"
                    Case 3: msg = "Path not found"
                    Case 5: msg = "Access denied"
                    Case 8: msg = "Out of memory"
                    Case 32: msg = "DLL not found"
                    Case 26: msg = "A sharing violation occurred"
                    Case 27: msg = "Incomplete or invalid file association"
                    Case 28: msg = "DDE Time out"
                    Case 29: msg = "DDE transaction failed"
                    Case 30: msg = "DDE busy"
                    Case 31: msg = "No association for file extension"
                    Case 11: msg = "Invalid EXE file or error in EXE image"
                    Case Is > 32: msg = "OK"
                    Case Else: msg = "Unknown error"
                    End Select
                    Debug.Print msg
                   
                    'File exists, exit the loop
                    Exit Do
                   
                End If 'FileExists
            End If 'Drivetype = CDROM
        Loop
    End If
End Sub

'##### Put the following in a Standard Module ######


Option Explicit

Public Declare Function GetDesktopWindow Lib "user32" () As Long
Public 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
Public Const SW_SHOWNORMAL = 1

Public Const INVALID_HANDLE_VALUE = -1
Public Const MAX_PATH = 260

Public Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Public Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long

Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
    (ByVal nDrive As String) As Long

Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
    Alias "GetLogicalDriveStringsA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Const DRIVE_CDROM& = 5

Public Function GetDriveStrings() As String
    ' Wrapper for calling the GetLogicalDriveStrings api
   
    Dim result As Long          ' Result of our API calls
    Dim strDrives As String     ' String to pass to API call
    Dim lenStrDrives As Long    ' Length of the above string
   
    ' Call GetLogicalDriveStrings with a buffer size of zero to
    ' find out how large our stringbuffer needs to be
    result = GetLogicalDriveStrings(0, strDrives)
   
    strDrives = String(result, 0)
    lenStrDrives = result
   
    ' Call again with our new buffer
    result = GetLogicalDriveStrings(lenStrDrives, strDrives)
   
    If result = 0 Then
        ' There was some error calling the API
        ' Pass back an empty string
        ' NOTE - TODO: Implement proper error handling here
        GetDriveStrings = ""
    Else
        GetDriveStrings = strDrives
    End If
End Function

Public Function FileExists(sSource As String) As Boolean

   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   
   hFile = FindFirstFile(sSource, WFD)
   FileExists = hFile <> INVALID_HANDLE_VALUE
   
   Call FindClose(hFile)
   
End Function

Public Function RunAssociatedFile(ByVal strDocName As String) As Long
    Dim Scr_hDC As Long
    Dim lngRes As Long
    Scr_hDC = GetDesktopWindow()
    RunAssociatedFile = ShellExecute(Scr_hDC, "Open", strDocName, "", "C:\", SW_SHOWNORMAL)
End Function
0
 
LVL 32

Expert Comment

by:Erick37
ID: 12311104
Did this work for you?
0
 

Author Comment

by:Anjinsan5
ID: 12444845
sorry it took me a while - got it to work!
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now