auxmoney - Geld leihen für das Studiumauxmoney - Geld leihen für das Studium

auxmoney - Geld leihen für den Umzugauxmoney - Geld leihen für den Umzug

MP3-Tag lesen und schreiben

MP3-Tag lesen und schreiben via ActiveX-EXE, Klassenmodul, Instanzen einer Anwendung
Sub Form_Load()
Top = 0
Left = Screen.Width - Width
End Sub
'-------- Lesen des Tags ----------------------
Sub File1_Click()
cmdKillOneTag.Visible = False
Call ReadMyFiles Einzelnen MP3-Tag teilweise lesen und in TextBoxen schreiben.
If txtArtist <> "" Or txtTitle <> "" Or txtAlbum <> "" Or _
txtYear <> "" Or txtGenreCode <> "255" Or txtComment <> "" Then
cmdKillOneTag.Visible = True
End If
End Sub
Sub Dir1_Change()
File1.FileName = Dir1.Path
Call EraseTXTBoxes
cmdWriteTag.Visible = False
cmdKillOneTag.Visible = False
If File1.ListCount > 1 Then
cmdSerie.Visible = True
cmdKillTag.Visible = True
Else
cmdSerie.Visible = False
cmdKillTag.Visible = False
End If
End Sub
Sub Dir1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
File1.ListIndex = -1
Call Dir1_Change
End Sub
Sub File1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If File1.ListCount > 0 Then
File1.ToolTipText = " Artist & Songname: Use Drag & Drop !!! "
End If
End Sub
Sub Drive1_Change()
Dim HelpStr$
HelpStr = Clipboard.GetText()
On Error GoTo Meldung 'Wenn Laufwerk nicht ansprechbar dann Fehlermeldung
If HelpStr <> "" Then
On Error GoTo 100
Dir1.Path = Clipboard.GetText()
Drive1.Drive = Clipboard.GetText()
On Error GoTo 0
Else
100:
Dir1.Path = Drive1.Drive 'Wählt ein Laufwerk in der DriveListBox aus
File1.FileName = Dir1.Path
End If
cmdWriteTag.Visible = False
cmdKillOneTag.Visible = False
Exit Sub 'Wenn Laufwerk ansprechbar, übergehe Fehlermeldung
Meldung:
Select Case MsgBox(Err.Description, 37, "Error No. " & Err.Number)
Case 2 'Programm-Exit
Resume Next
Case 4 'Befehl wiederholen
Resume
End Select
End Sub
'-------- Schreiben eines Tags ----------------------
Sub cmdWriteTag_Click()
Call WriteMyMP3
Call ReadMyFiles
End Sub
'-------- Schreiben der Tags in Serie -------------
Sub cmdSerie_Click()
Call WriteAllMP3s
End Sub
'-------- Löschen eines Tags -------------
Sub cmdKillOneTag_Click()
Call KillOneTag
Call ReadMyFiles
End Sub
'-------- Löschen der Tags in Serie -------------
Sub cmdKillTag_Click()
Call KillAllMP3Tags
End Sub
Sub txtAlbum_Change()
If File1.FileName = "" Then
cmdWriteTag.Visible = False
Else
cmdWriteTag.Visible = True
End If
End Sub
Sub txtAlbum_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then txtYear.SetFocus
End Sub
Sub txtAlbum_KeyPress(KeyAscii As Integer)
If File1.FileName = "" Then KeyAscii = 0
End Sub
Sub txtArtist_Change()
If File1.FileName = "" Then
cmdWriteTag.Visible = False
Else
cmdWriteTag.Visible = True
End If
End Sub
Sub txtArtist_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then txtTitle.SetFocus
End Sub
Sub txtArtist_KeyPress(KeyAscii As Integer)
If File1.FileName = "" Then KeyAscii = 0
End Sub
Sub txtArtist_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not File1.FileName = "" Then
Call Bindestrich_checken(Temp_Artist, Temp_Title)
txtArtist.Text = Temp_Artist
txtTitle.Text = Temp_Title
End If
End Sub
Sub txtComment_Change()
If File1.FileName = "" Then
cmdWriteTag.Visible = False
Else
cmdWriteTag.Visible = True
End If
End Sub
Sub txtComment_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then txtArtist.SetFocus
End Sub
Sub txtComment_KeyPress(KeyAscii As Integer)
If File1.FileName = "" Then KeyAscii = 0
End Sub
Sub txtGenreCode_Change()
If File1.FileName = "" Then
cmdWriteTag.Visible = False
Else
cmdWriteTag.Visible = True
End If
End Sub
Sub txtGenreCode_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then txtComment.SetFocus
End Sub
Sub txtGenreCode_KeyPress(KeyAscii As Integer)
If File1.FileName = "" Then KeyAscii = 0
Select Case Chr(KeyAscii)
Case "0" To "9"
Case Chr(vbKeyBack)
Case Else
KeyAscii = 0
End Select
End Sub
Sub txtTitle_Change()
If File1.FileName = "" Then
cmdWriteTag.Visible = False
Else
cmdWriteTag.Visible = True
End If
End Sub
Sub txtTitle_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then txtAlbum.SetFocus
End Sub
Sub txtTitle_KeyPress(KeyAscii As Integer)
If File1.FileName = "" Then KeyAscii = 0
End Sub
Sub txtTitle_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not File1.FileName = "" Then
Call Bindestrich_checken(Temp_Artist, Temp_Title)
txtArtist.Text = Temp_Artist
txtTitle.Text = Temp_Title
End If
End Sub
Sub txtYear_Change()
If File1.FileName = "" Then
cmdWriteTag.Visible = False
Else
cmdWriteTag.Visible = True
End If
End Sub
Sub txtYear_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then txtGenreCode.SetFocus
End Sub
Sub txtYear_KeyPress(KeyAscii As Integer)
If File1.FileName = "" Then KeyAscii = 0
Select Case Chr(KeyAscii)
Case "0" To "9"
Case Chr(vbKeyBack)
Case Else
KeyAscii = 0
End Select
End Sub
Sub cmdEnd_Click()
Clipboard.Clear
Unload Me
End Sub
Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Clipboard.Clear
End Sub
Function Bindestrich_checken(Temp_Artist, Temp_Title)
On Error GoTo ende
Temp_Artist = "": Temp_Title = "": Temp_File = ""
Temp_File = Trim(Left(File1.FileName, Len(File1.FileName) - 4))
Temp_Artist = Trim(Left$(Temp_File, InStr(1, Temp_File, "-") - 1))
Temp_Title = Trim(Right$(Temp_File, Len(Temp_File) - InStr(1, Temp_File, "-")))
Exit Function
ende:
MsgBox "FileName has no hyphen - ", vbCritical, "Error"
Temp_Artist = "": Temp_Title = "": Temp_File = ""
End Function
Public CurrentTag As TagInfo, FileName$, Tempp$
Public Temp_Artist$, Temp_Title$, Temp_File$
Public f As frmMP3
Public Type TagInfo
tag As String * 3
songname As String * 30
artist As String * 30
album As String * 30
year As String * 4
comment As String * 30
genre As String * 1
End Type
Public Sub Main()
Dim OldTitle$
If App.PrevInstance Then
OldTitle = App.Title
App.Title = "SampleToDelete"
AppActivate OldTitle
End
Else
Set f = frmMP3
If App.StartMode = vbSModeStandalone Then
f.Show
End If
End If
End Sub
Function ReadMyFiles() Einzelnen MP3-Tag lesen.
On Error Resume Next
f.cmdSerie.Visible = False
f.cmdKillTag.Visible = False
Call EraseTXTBoxes
If Right(f.Dir1.Path, 1) = "\" Then
FileName = f.Dir1.Path & f.File1.FileName
Else
FileName = f.Dir1.Path & "\" & f.File1.FileName
End If
Open FileName For Binary As #1
With CurrentTag
Get #1, FileLen(FileName) - 127, .tag
If Not .tag = "TAG" Then
f.txtArtist.Text = "N o T a g !"
Close #1
Exit Function
End If
Get #1, , .songname
Get #1, , .artist
Get #1, , .album
Get #1, , .year
Get #1, , .comment
Get #1, , .genre
Close #1
f.txtArtist = RTrim(.artist)
f.txtTitle = RTrim(.songname)
f.txtAlbum = RTrim(.album)
f.txtYear = RTrim(.year)
f.txtComment = RTrim(.comment)
Tempp = RTrim(.genre)
f.txtGenreCode = Asc(Tempp)
' f.Combo1.ListIndex = CInt(txtGenreCode) - 1
End With
f.cmdWriteTag.Visible = False
Tempp = ""
End Function
Public Sub EraseTXTBoxes()
f.txtTitle.Text = vbNullString
f.txtArtist.Text = vbNullString
f.txtAlbum.Text = vbNullString
f.txtYear.Text = vbNullString
f.txtComment.Text = vbNullString
End Sub
Function WriteMyMP3() Einen MP3-Tag schreiben.
Dim yearr%
If Right(f.Dir1.Path, 1) = "\" Then
FileName = f.Dir1.Path & f.File1.FileName
Else
FileName = f.Dir1.Path & "\" & f.File1.FileName
End If
If Not f.txtYear.Text = vbNullString Then yearr = f.txtYear.Text
If yearr = 0 Then
If f.txtYear.Text = vbNullString Then GoTo save1
MsgBox "Put the year between 1900 and 2100... and try again! ", vbCritical, "MP3-Tag Save Error"
f.txtYear.SetFocus
f.txtYear.SelStart = 0
f.txtYear.SelLength = Len(f.txtYear.Text)
Exit Function
End If
save1:
If yearr < 1900 Or yearr > 2100 Then
If f.txtYear.Text = vbNullString Then GoTo save2
MsgBox "Put the year between 1900 and 2100... and try again! ", vbCritical, "MP3-Tag Save Error"
f.txtYear.SetFocus
f.txtYear.SelStart = 0
f.txtYear.SelLength = Len(f.txtYear.Text)
Exit Function
End If
save2:
If f.txtTitle.Text = "" Or f.txtArtist.Text = "" Then
MsgBox "No entry for Artist or Songname...! ", vbCritical, "MP3-Tag Save Error"
Else
If f.File1.FileName = "" Then Exit Function
With CurrentTag
.tag = "TAG"
.songname = f.txtTitle
.artist = f.txtArtist
.album = f.txtAlbum
.year = f.txtYear
.comment = f.txtComment
'' .genre = Chr(f.Combo1.ListIndex + 1)
.genre = Chr("255") 'erzeugt keinen Eintrag
On Error GoTo Meldung
Open FileName For Binary Access Write As #1
Seek #1, FileLen(FileName) - 127
Put #1, , .tag
Put #1, , .songname
Put #1, , .artist
Put #1, , .album
Put #1, , .year
Put #1, , .comment
Put #1, , .genre
Close #1
End With
End If
On Error GoTo 0
f.txtArtist.SetFocus
f.cmdWriteTag.Visible = False
Exit Function
Meldung:
MsgBox "You can't save to an open file...! ", vbCritical, "MP3-Tag Save Error"
Exit Function
End Function
Function WriteAllMP3s() Alle MP3-Tags im Verzeichnis schreiben.
Dim i&, i2&, FileNam()
i = 0: i2 = 0
Select Case MsgBox("Program will take 'Artist' and 'Songname' from Filename! " & vbCrLf _
& "Please close all Files in WinAmp and De-Select Files in Explorer... " _
& vbCrLf & vbCrLf & "Write all Files in this Directory? ", _
vbQuestion + vbYesNo + vbDefaultButton2, "Write All Files?")
Case vbYes
For i = 0 To f.File1.ListCount - 1
10:
ReDim Preserve FileNam(1 To i + 1)
FileNam(i + 1) = f.File1.List(i)
If Right(f.Dir1.Path, 1) = "\" Then
FileNam(i + 1) = f.Dir1.Path & f.File1.List(i)
Else
FileNam(i + 1) = f.Dir1.Path & "\" & f.File1.List(i)
End If
If FileNam(i + 1) = "" Then Exit Function
On Error GoTo error_counter
With CurrentTag
Temp_Artist = "": Temp_Title = "": Temp_File = ""
Temp_File = Trim(Left(f.File1.List(i), Len(f.File1.List(i)) - 4))
Temp_Artist = Left$(Temp_File, InStr(1, Temp_File, "-") - 1)
Temp_Title = Right$(Temp_File, (Len(f.File1.List(i)) - 4) - (InStr(1, Temp_File, "-")))
.tag = "TAG"
.songname = LTrim(Temp_Title)
.artist = RTrim(Temp_Artist)
.album = vbNullString
.year = vbNullString
.comment = vbNullString
.genre = Chr("255") 'erzeugt keinen Eintrag
Open FileNam(i + 1) For Binary Access Write As #1
Seek #1, FileLen(FileNam(i + 1)) - 127
Put #1, , .tag
Put #1, , .songname
Put #1, , .artist
Put #1, , .album
Put #1, , .year
Put #1, , .comment
Put #1, , .genre
Close #1
On Error GoTo 0
End With
Next i
End Select
If i2 = 0 And i > 0 Then
MsgBox i & " MP3-Tags Saved! ", vbInformation, "MP3-Tags Saved"
ElseIf i2 > 0 Then
MsgBox "You can't save " & i2 & " file(s)...! ", vbCritical, "MP3-Tag Save Error"
End If
f.txtArtist.SetFocus
f.cmdWriteTag.Visible = False
f.cmdSerie.Visible = False
f.cmdKillTag.Visible = False
Exit Function
error_counter:
i2 = i2 + 1
i = i + 1
GoTo 10
End Function
Function KillOneTag() Einen MP3-Tag löschen.
If Right(f.Dir1.Path, 1) = "\" Then
FileName = f.Dir1.Path & f.File1.FileName
Else
FileName = f.Dir1.Path & "\" & f.File1.FileName
End If
If f.File1.FileName = "" Then Exit Function
With CurrentTag
.tag = vbNullString
.songname = vbNullString
.artist = vbNullString
.album = vbNullString
.year = vbNullString
.comment = vbNullString
' .genre = Chr(f.Combo1.ListIndex + 1)
.genre = Chr("255") 'erzeugt keinen Eintrag
On Error GoTo Meldung
Open FileName For Binary Access Write As #1
Seek #1, FileLen(FileName) - 127
Put #1, , .tag
Put #1, , .songname
Put #1, , .artist
Put #1, , .album
Put #1, , .year
Put #1, , .comment
Put #1, , .genre
Close #1
End With
On Error GoTo 0
f.txtArtist.SetFocus
f.cmdWriteTag.Visible = False
f.cmdKillOneTag.Visible = False
Exit Function
Meldung:
MsgBox "You can't save to an open file...! ", vbCritical, "MP3-Tag Save Error"
Exit Function
End Function
Function KillAllMP3Tags() Alle MP3-Tags im Verzeichnis löschen.
Dim i&, i2&, FileNam()
i = 0: i2 = 0
Select Case MsgBox("Program will k i l l all Tags from File! " & vbCrLf _
& "Please close all Files in WinAmp and De-Select Files in Explorer... " _
& vbCrLf & vbCrLf & "Kill all Tags in this Directory? ", _
vbQuestion + vbYesNo + vbDefaultButton2, "Kill All Tags?")
Case vbYes
For i = 0 To f.File1.ListCount - 1
10:
ReDim Preserve FileNam(1 To i + 1)
FileNam(i + 1) = f.File1.List(i)
If Right(f.Dir1.Path, 1) = "\" Then
FileNam(i + 1) = f.Dir1.Path & f.File1.List(i)
Else
FileNam(i + 1) = f.Dir1.Path & "\" & f.File1.List(i)
End If
If FileNam(i + 1) = "" Then Exit Function
On Error GoTo error_counter
With CurrentTag
.tag = vbNullString
.songname = vbNullString
.artist = vbNullString
.album = vbNullString
.year = vbNullString
.comment = vbNullString
.genre = Chr("255") 'erzeugt keinen Eintrag
Open FileNam(i + 1) For Binary Access Write As #1
Seek #1, FileLen(FileNam(i + 1)) - 127
Put #1, , .tag
Put #1, , .songname
Put #1, , .artist
Put #1, , .album
Put #1, , .year
Put #1, , .comment
Put #1, , .genre
Close #1
On Error GoTo 0
End With
Next i
End Select
If i2 = 0 And i > 0 Then
MsgBox i & " MP3-Tags Killed! ", vbInformation, "MP3-Tags Killed"
ElseIf i2 > 0 Then
MsgBox "You can't save " & i2 & " file(s)...! ", vbCritical, "MP3-Tag Save Error"
End If
f.txtArtist.SetFocus
f.cmdWriteTag.Visible = False
f.cmdSerie.Visible = False
f.cmdKillTag.Visible = False
Exit Function
error_counter:
i2 = i2 + 1
i = i + 1
GoTo 10
End Function
Klassenmodul:
Private Sub Class_Initialize()
If Forms.Count = 0 Then
Load frmMP3
End If
With frmMP3
If .WindowState = vbMinimized Then
.WindowState = vbNormal
End If
.Show
End With
End Sub
Public Function MP3Start(Params As String) As Variant
On Error GoTo weiter
frmMP3.Dir1.Path = Clipboard.GetText()
frmMP3.Drive1.Drive = Clipboard.GetText()
Exit Function
weiter:
On Error Resume Next
frmMP3.Dir1.Path = "C:\"
frmMP3.Drive1.Drive = "C:\"
End Function
Starter-EXE:
Public Sub Main()
Dim Instanz As ReadWriteMP3.MP3Instanz
Set Instanz = New ReadWriteMP3.MP3Instanz
With New ReadWriteMP3.MP3Instanz
.MP3Start Command$
End With
End Sub
Instanzen eines Formulars
Die Eigenschaft PrevInstance des App-Objekts teilt mit, ob bereits weitere Instanzen einer Anwendung laufen. Wenn man nun bei
einem erneuten Start einer Anwendung eine solche vorhergehende Instanz lediglich aktivieren möchten, anstatt die Anwendung
zum zweiten Mal auszuführen, bedarf es einiger Kunstgriffe. Visual Basic hält dazu keine eigenen Bordmittel bereit.
Eine bekannte Möglichkeit ist, über eine Reihe von API-Funktionen ein Fenster (Form) der vorhergehenden Instanz ausfindig zu machen
und zu aktivieren, und es gegebenenfalls wiederherzustellen, falls es minimiert sein sollte. In der Regel funktioniert dies auch ganz gut.
Allzu sicher ist das Verfahren jedoch nicht, da zwischen der bereits laufenden Instanz und der sich um die Reaktivierung derselben
bemühenden neuen Instanz keinerlei direkte Beziehung besteht. Zum einen kann man unabsichtlich eine völlig andere Anwendung
reaktivieren, falls zufällig verschiedene Namensübereinstimmungen zur eigenen Anwendung bestehen sollten.
Zum anderen kann die neue Instanz nichts über den Zustand der laufenden Anwendung wissen. Sie kann vielleicht vergeblich nach dem zu
reaktivierenden Form suchen, während dieses gar nicht geladen ist. Oder dieses Form ist zufällig gesperrt, weil der Anwender gerade ein
anderes Form der Anwendung modal geöffnet hat. Je nach Komplexität Ihrer Anwendung können weitere Unwägbarkeiten hinzukommen,
über die sich die neu startende Instanz nur mit (für VB-Verhältnisse) recht hohem Aufwand über API-Mechanismen informieren könnte.
Auch ist eine gezielte Kommunikation zwischen den beiden Instanzen, etwa Übergabe der Kommandozeilen-Parameter der neuen
Instanz an die alte und dergleichen, nicht so einfach zu erreichen.
Mit nur minimalem Aufwand kann man hingegen über ActiveX einen sicheren und sehr flexiblen Mechanismus etablieren, mit
direkter Verständigung zwischen der laufenden und jeder neu hinzukommenden Instanz. Und natürlich mit problemloser Übergabe
der Kommandozeilen-Parameter von der neuen an die laufende Instanz.
Dazu verwandelt man die eigentliche Anwendung in eine ActiveX-EXE und schalten eine kleine Starter-Anwendung (weiterhin
eine gewöhnliche Standard-EXE) vor.
Diese Starter-EXE erweckt die ActiveX-EXE beim ihrem ersten Aufruf zum Leben. Bei jedem weiteren Aufruf reaktiviert sie nur noch
die bereits laufende Instanz der ActiveX-EXE, und kann mit ihr beliebig Informationen austauschen oder Anweisungen an sie absetzen.
Die zur ActiveX-EXE mutierte Anwendung (die wir hier ReadWriteMP3 nennen) benötigt zusätzlich nichts weiter, als eine öffentliche
und instanzierbare Klasse, die wir hier MP3Instanz nennen. Diese Klasse braucht noch nicht einmal über Methoden und
Eigenschaften zu verfügen. Lediglich eine Class_Initialize-Prozedur wird benötigt. In dieser lädt man das Hauptform der Anwendung,
falls es noch nicht geladen sein sollte. Und hier reaktiviert man es und stellt es wieder her, falls es minimiert sein sollte.
Private Sub Class_Initialize()
If Forms.Count = 0 Then
Load Form1
End If
With Form1
If .WindowState = vbMinimized Then
.WindowState = vbNormal
End If
.Show
End With
End Sub
Die Starter-EXE besteht nur aus einem Standard-Modul mit einer Sub Main-Prozedur.
Dazu nimmt man einen Verweis auf die ActiveX-EXE-Anwendung auf:
Die (ActiveX)-ReadWriteMP3.exe wird zuerst ins Verzeichnis C:\WINNT kompiliert !
Die Starter.exe erhält dann einen Verweis auf die ReadWriteMP3.exe und wird ebenfalls ins Verzeichnis C:\WINNT kompiliert.
Es ist zu beachten, dass die Klasse Instance separat deklariert und instanziert werden muss.
Bei einer Deklaration wie
Dim Instanz As New Instanz
würde nämlich nicht sofort deren Class_Initialize-Prozedur aufgerufen, sondern erst bei einem Zugriff auf eine Methode oder
Eigenschaft der Klasse - über die diese nicht verfügt.
Public Sub Main()
Dim Instanz As ReadWriteMP3.MP3Instanz
Set Instanz = New ReadWriteMP3.MP3Instanz
End Sub
Das war nun auch schon alles. Der einzige Unterschied zur früher "normalen" Anwendung besteht darin, dass der Anwender
diese nicht mehr direkt startet, sondern statt dessen nur noch die Starter-EXE.
Falls es jedoch weiterhin möglich sein soll, ganz bewusst eine zweite Instanz der Anwendung zu starten, ruft man die Starter-EXE
mit einem Kommandozeilen-Parameter (beispielsweise "/X") auf. In der Sub Main-Prozedur ruft man also die ActiveX-EXE als
Standalone-Anwendung auf (beide EXEs sollten sich der Einfachheit halber im gleichen Verzeichnis befinden).
Public Sub Main()
Dim nInstance As Instance
If UCase$(Command$) = "/X" Then
Shell "Anwendung.exe", vbNormalFocus
Else
Set nInstance = New Instance
End If
End Sub
Damit auch dann das Hauptform der Anwendung geladen und angezeigt wird, braucht nun auch die ActiveX-EXE ein
Standard-Modul mit einer Sub Main-Prozedur.
Public Sub Main()
If App.StartMode = vbSModeStandalone Then ' wird in den Projekteigenschaften der ActiveX-EXE festgelegt
Form1.Show
End If
End Sub
Bis jetzt fehlt allerdings noch die Möglichkeit des Informationsaustauschs zwischen der als ActiveX-EXE laufenden Anwendung
und einer später gestarteten Starter-EXE.
Eine wie bisher sozusagen "stumme" Verbindungsklasse braucht ja schließlich nicht zu sein. Man kann die Klasse Instances mit
einer Methode (die wir hier MP3Start nennen) versehen, der man die Kommandozeile als Parameter übergibt. In dieser Methode
hat man vollen Zugriff auf die Anwendung - über die Forms-Collection auf alle geladenen Forms und auf globale Variablen.
Hier kann man nach Herzenslust die Kommandozeile auswerten und anstellen, was immer man will:
Public Function MP3Start(Params As String) As Variant
frmMP3.Dir1.Path = Clipboard.GetText() 'hier: Werte aus der Zwischenablage übergeben
frmMP3.Drive1.Drive = Clipboard.GetText() 'Visual Basic hat ein Clipboard-Objekt
End Sub
Man kann auch den bisherigen Inhalt der Class_Initialize-Prozedur hierher verschieben und so etwa gegebenenfalls
anhand der übergebenen Kommandozeile entscheiden, welches Form (re)aktiviert werden soll. So kann man auch schon
beim ersten Start die Kommandozeile nach Belieben auswerten.
In der Sub Main-Prozedur ruft man zusätzlich diese Methode auf:
Public Sub Main()
Dim Instanz As ReadWriteMP3.MP3Instanz
Set Instanz = New ReadWriteMP3.MP3Instanz
If UCase$(Command$) = "/X" Then
Shell "Anwendung.exe", vbNormalFocus
Else
With New ReadWriteMP3.MP3Instanz
.MP3Start Command$
End With
End If
End Sub
Übergabe eines Zellwertes aus VBA-Excel an die Zwischenablage
"altes" Makro mit Abfrage nach Dateiname und Programmaufruf mit Shell...
Sub cmdWriteTag_Click()
Dim DateiName$, AbLage As DataObject
DateiName = "C:\WINNT\StartMP3.exe" 'Aufruf der Starter-EXE
If Dir(DateiName) = "" Then
MsgBox "Die Datei zum Lesen / Schreiben des MP3-Tags ist nicht " & Chr(10) & _
"vorhanden (StartMP3.exe)! " & Chr(10) & Chr(10) & _
"Der Programmpfad muss im Quellcode angepasst werden! ", vbInformation, "Info"
Else
On Error GoTo 100
Set AbLage = New DataObject 'Im Gegensatz zu VB gibt es bei VBA kein Clipboard-Objekt
If ActiveCell.Value <> "" Then
AbLage.SetText ActiveCell.Value
AbLage.PutInClipboard
Call Shell(DateiName, 1)
On Error GoTo 0
Else
100:
Call Shell(DateiName, 1)
End If
End If
End Sub
... und dann bauen wir die Starter-EXE mal in VBA-Excel ein. Wir basteln uns einen Verweis...
Sub cmdWriteTag_Click()
Dim AbLage As DataObject
Set AbLage = New DataObject
If ActiveCell.Value <> "" Then
'Zellenwert in die Zwischenablage
AbLage.SetText ActiveCell.Value
AbLage.PutInClipboard
CallInstanz
End If
End Sub
Function CallInstanz() 'Code steht im Modul
Dim Instanz As ReadWriteMP3.MP3Instanz
Set Instanz = New ReadWriteMP3.MP3Instanz
With New ReadWriteMP3.MP3Instanz
.MP3Start Command$
End With
End Function
- Zelle im Excel-Sheet markieren
- Gewünschter Pfad erscheint immer in der ActiveX-EXE (es bleibt stets nur eine Instanz geöffnet)
VBA-Anwendung: ActiveX-EXE:
Erkenntnisse
Da im VBA keine ActiveX-Fehler abgefangen werden können ("On Error" funktioniert nicht, falls sich die ActiveX-EXE nicht in
ihrem Stammverzeichnis befindet) empfiehlt sich die Variante mit der Starter-EXE (dann sendet das System wenigstens
eine MsgBox "Automatisierungsfehler").
Der Programmstart (mit Start-EXE) klappt auch über SendTo oder aus dem Startmenü; es braucht sich nur ein gültiger Dateipfad
in der Zwischenablage befinden!
Falls die ActiveX-EXE versehentlich mehrfach allein geöffnet wird, laufen dennoch mehrere Instanzen.
Dieser Nebeneffekt wird abgefangen mit:
Public Sub Main()
Dim OldTitle$
If App.PrevInstance Then 'Läuft von dieser Anwendung schon eine Instanz?
OldTitle = App.Title 'Dann den Titel dieser aktuellen Instanz umbenennen
App.Title = "SampleToDelete"
AppActivate OldTitle 'Aktuelle Instanz schließen
End
Else
If App.StartMode = vbSModeStandalone Then
Form1.Show
End If
End If
End Sub

Mehr Tipps: Icon der Excel-Anwendung ändern

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt