mp3 tag
fredy
quiero saber con vba que campos puedo obtener de un archivo binario mp3 tag.
la idea es listar los datos de mis mp3 y editarlos en una tabla de excel
para luego editar el archivo binario..
muchas gracias
coloco un ejemplo de como extraigo los datos, pero necesito saber el listado
total de campos que puedo obtener ya que aqui solo figuran unos cuantos
campos.. (siete)
Option Explicit
'Udt con la info del Tag
Type T_Tag_Mp3
Header As String * 3
SongTitle As String * 30
Artist As String * 30
Album As String * 30
Year As String * 4
Comment As String * 30
Genre As Byte
End Type
Public Function Extraer_Tag_Mp3(Path_MP3 As String) As T_Tag_Mp3
On Error GoTo errSub
Dim archivo As Long
If Dir(Path_MP3) = "" Then Exit Function
archivo = FreeFile
'Abrimos el archivo Mp3 en modo binario de lectura
Open Path_MP3 For Binary Access Read As archivo
'Leemos la posición y almacenamos los datos en la función
Get archivo, LOF(1) - 127, Extraer_Tag_Mp3
'Cerramos el Archivo
Close archivo
Exit Function
'Error
errSub:
Close archivo
MsgBox Err.Description, vbCritical, " Ocurrió un error al leer el MP3 "
End Function
H�ctor Miguel
> quiero saber con vba que campos puedo obtener de un archivo binario mp3 tag.
> la idea es listar los datos de mis mp3 y editarlos en una tabla de excel para luego editar el archivo binario...
aqui encuentras otros mecanismos y ejemplos:
Reading info from mp3 files using Shell32: -> http://tinyurl.com/mzumgb
read info mp3 file: -> http://tinyurl.com/l9r2bh
Shell32: -> http://tinyurl.com/nmvw47
si cualquier duda... comentas ?
saludos,
hector.
__ OP __
> coloco un ejemplo de como extraigo los datos, pero necesito saber el listado total de campos que puedo obtener
> ya que aqui solo figuran unos cuantos campos.. (siete)
>
> 'Udt con la info del Tag
> Type T_Tag_Mp3
> Header As String * 3
> SongTitle As String * 30
> Artist As String * 30
> Album As String * 30
> Year As String * 4
> Comment As String * 30
> Genre As Byte
> End Type
>
> Public Function Extraer_Tag_Mp3(Path_MP3 As String) As T_Tag_Mp3
> On Error GoTo errSub
> Dim archivo As Long
> If Dir(Path_MP3) = "" Then Exit Function
> archivo = FreeFile
> 'Abrimos el archivo Mp3 en modo binario de lectura
> Open Path_MP3 For Binary Access Read As archivo
> 'Leemos la posicion y almacenamos los datos en la funcion
> Get archivo, LOF(1) - 127, Extraer_Tag_Mp3
> 'Cerramos el Archivo
> Close archivo
> Exit Function
> 'Error
> errSub:
> Close archivo
> MsgBox Err.Description, vbCritical, " Ocurrio un error al leer el MP3 "
> End Function
H�ctor Miguel
si le tienes "flojerilla" a leer post para tomar notas (?) prueba con una macro +/- como la siguiente:
ten lista una hoja en blanco y escribe la ruta donde se almacenan esos archivos en la celda [A1]
(p.e. c:\documents and settings\<usuario>\mis documentos\mi musica )
si no quieres condicionar el tipo (o no lo conoces con exactitud) quita el segundo If -instr- (y su End If obviamente)
saludos,
hector.
Sub Info_de_musicales()
Dim Ruta As String, Fila As Integer, Col As Byte, _
Archivo As Object, n As Byte, Tipo As String
Application.ScreenUpdating = False
Ruta = Range("a1")
Tipo = "mp3" ' "windows media"
Cells.Clear
With CreateObject("shell.application")
With .Namespace(CStr(Ruta))
Fila = 3
Col = 1
For n = 0 To 40
Cells(Fila, Col) = .GetDetailsOf(.items, n)
Fila = Fila + 1
Next
Col = 2
For Each Archivo In .items
Fila = 2
If Not Archivo.IsFolder Then
If InStr(1, .GetDetailsOf(Archivo, 2), Tipo, vbTextCompare) Then
Fila = Fila + 1
For n = 0 To 40
On Error Resume Next
Cells(Fila, Col) = .GetDetailsOf(Archivo, n)
Fila = Fila + 1
Next
Col = Col + 1
End If
End If
Next
End With
End With
Cells.EntireColumn.AutoFit
Range("a1") = Ruta
End Sub
fredy
muchas gracias .. Hector ..el listado que sale, era el que queria.., la idea
es editar el archivo binario (tag) , ya que en la tabla de excel hice los
cambios que deseaba, .. pero como hago esto... estuve navegand un rato y
encontr esta funcion.. pero no se como utilizarla... intente de la siguiente
manera pero no funcionO...=)
Sub cambiar()
Dim RUTA, ARCHIVO, RUTAMP3, EDITAR
RUTA = Cells(1, 1)
ARCHIVO = Cells(4, 1)
RUTAMP3 = RUTA & "/" & ARCHIVO
SetID3Tagdirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada
nadita", "2500", Cells(4, 13))
End Sub
la funcion es esta:
Option Explicit
Public Type ID3Tag
Header As String * 3
SongTitle As String * 30
Artist As String * 30
Album As String * 30
Year As String * 4
Comment As String * 30
Genre As Byte
End Type
Public Function SetID3TagDirect(ByVal FileName As String, _
ByVal Artist_30 As String, ByVal SongTitle_30 As String, _
ByVal Album_30 As String, ByVal Comment_30 As String, _
ByVal Year_4 As String, ByVal Genre_B255 As Byte) As Boolean
Dim Tag As ID3Tag
On Error GoTo SetID3TagDirectError
Dim FileNum As Long
If Dir(FileName) = "" Then
SetID3TagDirect = False
Exit Function
End If
Tag.Header = "TAG"
Tag.Artist = Artist_30
Tag.SongTitle = SongTitle_30
Tag.Album = Album_30
Tag.Comment = Comment_30
Tag.Year = Year_4
Tag.Genre = Genre_B255
FileNum = FreeFile
Open FileName For Binary As FileNum
Put FileNum, LOF(1) - 127, Tag
Close FileNum
SetID3TagDirect = True
Exit Function
SetID3TagDirectError:
Close FileNum
SetID3TagDirect = False
End Function
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
muchas gracias
H�ctor Miguel
lo unico que veo como posible causa de errores (que no comentas cuales son exactamente los que obtienes)
es que defines un tipo personalizado con un nombre que luego cambias en el codigo (por lo que no existe el que usas)
lo defines aqui:
> Public Type ID3Tag
pero lo llamas de la siguiente forma:
> Tag.Header = "TAG"
> Tag.Artist = Artist_30
> Tag.SongTitle = SongTitle_30
> Tag.Album = Album_30
> Tag.Comment = Comment_30
> Tag.Year = Year_4
> Tag.Genre = Genre_B255
entonces... o se llama ID3Tag o se llama Tag (???)
saludos,
hector.
__ OP __
> ... la idea es editar el archivo binario... ya que en la tabla de excel hice los cambios que deseaba
> .. pero como hago esto... estuve navegand un rato y encontr esta funcion.. pero no se como utilizarla...
> intente de la siguiente manera pero no funcionO...=)
>
> Sub cambiar()
> Dim RUTA, ARCHIVO, RUTAMP3, EDITAR
> RUTA = Cells(1, 1)
> ARCHIVO = Cells(4, 1)
> RUTAMP3 = RUTA & "/" & ARCHIVO
>
> SetID3Tagdirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada nadita", "2500", Cells(4, 13))
> End Sub
>
> la funcion es esta:
>
fredy
Hector
el error me sale al definir los parametros de la funcion:
SetID3TagDirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada
sale en rojo y un mensaje que dice, "error de compilacion se esperaba:="
eso me sale en la rutina:
> Sub cambiar()
> Dim RUTA, ARCHIVO, RUTAMP3, EDITAR
> RUTA = Cells(1, 1)
> ARCHIVO = Cells(4, 1)
> RUTAMP3 = RUTA & "/" & ARCHIVO
>
> SetID3Tagdirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada nadita", "2500", Cells(4, 13))
> End Sub
ni siquiera alcanza allegar a la funcion... una pregunta seria... estoy
utilizando mal la funcion, o ingresando mal los parametros?
muchas gracias Hector
"Héctor Miguel" wrote:
> .
>
fredy
el error me sale al definir los parametros de la funcion:
sale en rojo y un mensaje que dice, "error de compilacion se esperaba:="
eso me sale en la rutina:
> Sub cambiar()
> Dim RUTA, ARCHIVO, RUTAMP3, EDITAR
> RUTA = Cells(1, 1)
> ARCHIVO = Cells(4, 1)
> RUTAMP3 = RUTA & "/" & ARCHIVO
>
> SetID3Tagdirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada nadita", "2500", Cells(4, 13))
> End Sub
ni siquiera alcanza allegar a la funcion... una pregunta seria... estoy
utilizando mal la funcion, o ingresando mal los parametros?
muchas gracias
"Héctor Miguel" wrote:
> .
>
H�ctor Miguel
__ 1 __
> el error me sale al definir los parametros de la funcion:
> SetID3TagDirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada nadita", "2500", Cells(4, 13))
> sale en rojo y un mensaje que dice, "error de compilacion se esperaba:=" (...)
__ 2 __
> ni siquiera alcanza allegar a la funcion... una pregunta seria... estoy utilizando mal la funcion, o ingresando mal los parametros?
1) al hacer llamadas a una funcion de vba, necesitas que sean asignadas a algun objeto o variable (p.e.)
en lugar de llamarla asi:
SetID3TagDirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada nadita", "2500", Cells(4, 13))
prueba con alguna/s de la/s siguiente formas:
op1: Tmp = SetID3TagDirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada nadita", "2500", Cells(4, 13))
op2: Call SetID3TagDirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada nadita", "2500", Cells(4, 13))
op3: SetID3TagDirect RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18), "nada nadita", "2500", Cells(4, 13)
2) de todas formas, comprueba/corrige/... cual es el nombre "correcto" del tipo de datos definido por el usuario:
fredy
ya realice los cambios que sugeriste.. y ya pasa sin errores pero no veo los
resultados de la edicion de atributos.. no veo que cambien..
este es el codigo como quedo:
'XXXXXXXXXXXXXXXXXXXXXX
Option Explicit
Public Type Tag 'ID3Tag
Header As String * 3
SongTitle As String * 30
Artist As String * 30
Album As String * 30
Year As String * 4
Comment As String * 30
Genre As String
End Type
Public Function SetTagDirect(ByVal FileName As String, _
ByVal Artist_30 As String, ByVal SongTitle_30 As String, _
ByVal Album_30 As String, ByVal Comment_30 As String, _
ByVal Year_4 As String, ByVal Genre_B255 As String) As Boolean
Dim Tag As Tag
On Error GoTo SetTagDirectError
Dim FileNum As Long
If Dir(FileName) = "" Then
SetTagDirect = False
Exit Function
End If
Tag.Header = "TAG"
Tag.Artist = Artist_30
Tag.SongTitle = SongTitle_30
Tag.Album = Album_30
Tag.Comment = Comment_30
Tag.Year = Year_4
Tag.Genre = Genre_B255
FileNum = FreeFile
Open FileName For Binary As FileNum
Put FileNum, LOF(1) - 150, Tag
Close FileNum
SetTagDirect = True
Exit Function
SetTagDirectError:
Close FileNum
SetTagDirect = False
End Function
Sub cambiar()
Dim RUTA, ARCHIVO, RUTAMP3, EDITAR
RUTA = Cells(1, 1)
ARCHIVO = Cells(4, 1)
RUTAMP3 = RUTA & "\" & ARCHIVO
Call SetID3TagDirect(RUTAMP3, Cells(4, 11), Cells(4, 10), Cells(4, 18),
"nada nadita", "2500", "vallenatero")
End Sub
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
ahora que sera?
muchas gracias
"Héctor Miguel" wrote:
> .
>
H�ctor Miguel
> ya realice los cambios que sugeriste y ya pasa sin errores pero no veo los resultados de la edicion de atributos, no veo que cambien...
en el codigo que expusiste originalmente (el que encontraste navegando por la red) contenia una instruccion "especifica"...
> Put FileNum, LOF(1) - 127, Tag
que en el codigo (modificado) que expones en esta consulta, lo cambiaste a...
> Put FileNum, LOF(1) - 150, Tag
PERO... la instruccion original "busca" en el archivo un "largo" exacto de 128 bytes (- 127)
que abriendo archivos a nivel I/O (entrada/salida de dispositivos) es como "borrar" el final del archivo y escribirle un "nuevo final"
saludos,
hector.
__ resto de OP __
> este es el codigo como quedo:
> ahora que sera?
H�ctor Miguel
creo que existe otra (posible) incongruencia en los codigos...
cuando se abre el archivo (I/O binario) se le nombra...
> Dim FileNum As Long
y se establece su referencia como...
> Open FileName For Binary As FileNum
PERO... cuando se (re)escribe el nuevo final, se utiliza...
> Put FileNum, LOF(1) - 127, Tag
cabria la posibilidad de que el archivo abierto (I/O) con el indice 1 -> LOF(1)
se cruzara con otros archivos abiertos por cualquier otra aplicacion (temporalmente ?) en el sistema (???)
prueba tambien cambiando a la referencia especifica del archivo instanciado...
> Put FileNum, LOF(FileName) - 127, Tag
saludos,
hector.
fredy
Hola Hector...
intente muchos cambios y no logre un resultado bueno... entonces decidi
buscar un poco mas en la web y encontre algo que me sirvio. te lo copio..:
).. muchas gracias por tu colaboracion
______________________________________
'==========================================================================================================
'- MACRO TO CHANGE EXTENDED FILE PROPERTIES OF .MP3 AND .WMA FILES IN
WINDOWS EXPLORER
'- Reads from amended worksheet prepared with separate "READ_FROM_EXPLORER"
macro module.
'==
'==========================================================================================================
'- .WMA files do not have track number column 4
'- this version uses CDDBControlRoxio.dll
'- (was unable to get CDDBControl.dll version 1.2.0.51 to change more than 1
file without crashing)
'- Suggest you copy some files to a special folder for testing first.
'- Brian Baulsom May 2008 - using Excel 2000/Windows XP
'==========================================================================================================
'==========================================================================================================
'- Method (works on all files in a single folder)
'- 1. Run macro "READ_FROM_EXPLORER" (other module) TO GET FILE NAMES INTO
CURRENTLY ACTIVE WORKSHEET
'- 2. Amend file details in the worksheet. Delete rows for files not changed
to save time (can be left).
'- 3. Run macro "WRITE_TO_EXPLORER" below.
'==========================================================================================================
'- also uses Public variables in READ macro module
Dim ws As Worksheet
Dim FromRow As Long
Dim LastRow As Long
Dim FilesToChange As Integer ' number of files to change
Dim FilesChanged As Integer ' number of files changed
Dim MyFilePathName As String ' full path & file name
Dim MyFileType As String ' mp3 wma etc.
'-
Dim id3 As Object
Dim MyArtist As String
Dim MyAlbum As String
Dim MyGenre As String
Dim MyTrack As String
Dim MyTitle As String
'==========================================================================================================
'- MAIN ROUTINE
'- Run down visible rows and change data
'- worksheet has full path & file name in column O
'==========================================================================================================
Sub WRITE_TO_EXPLORER()
Application.Calculation = xlCalculationManual
Set ws = ActiveSheet
Set id3 = CreateObject("CDDBControlRoxio.CddbID3Tag")
'-----------------------------------------------------------------------------------------------------
'- CHECK NUMBER OF FILES TO CHANGE (VISIBLE ROWS)
LastRow = ws.Range("A65536").End(xlUp).Row ' count worksheet rows
FilesToChange = ws.Range("A2:A" &
LastRow).SpecialCells(xlCellTypeVisible).Count
If FilesToChange = 0 Then MsgBox ("No files to change."): Exit Sub
FilesChanged = 0
'-----------------------------------------------------------------------------------------------------
'- LOOP WORKSHEET FILES - VISIBLE ROWS ONLY
For FromRow = 2 To LastRow
If ws.Cells(FromRow, "A").EntireRow.Hidden = False Then
'---------------------------------------------------------------------------------------------
'- Get file properties from sheet
With ws
MyFilePathName = .Cells(FromRow, "O").Value
MyFileType = UCase(Right(MyFilePathName, 3))
Application.StatusBar = FileCount & "\" & FilesToChange
& " " & MyFilePathName 'STATUSBAR
MyArtist = .Cells(FromRow, "B").Value
MyAlbum = .Cells(FromRow, "C").Value
MyTrack = .Cells(FromRow, "E").Value
MyGenre = .Cells(FromRow, "F").Value
MyTitle = .Cells(FromRow, "H").Value
End With
'---------------------------------------------------------------------------------------------
'- Write to file
With id3
.LoadFromFile MyFilePathName, False ' True = Read Only
.LeadArtist = MyArtist
.Album = MyAlbum
.Genre = MyGenre
.Title = MyTitle
If MyFileType = "MP3" Then .TrackPosition = MyTrack
.SaveToFile MyFilePathName
End With
'---------------------------------------------------------------------------------------------
FilesChanged = FilesChanged + 1
End If
Next
'-----------------------------------------------------------------------------------------------------
'- end of program
Application.Calculation = xlCalculationAutomatic
rsp = MsgBox("Done" & vbCr & "Changed " & FilesChanged & " of " &
FilesToChange)
Application.StatusBar = False
End Sub
'======= END OF MAIN
======================================================================================
EN OTRO MODULO
'============================================================================================================
'- READ .MP3 & .WMA FILE PROPERTIES TO A WORKSHEET
'============================================================================================================
'- MACRO TO :-
'- *1. SELECT A FOLDER - *2. CLEAR THE ACTIVE WORKSHEET* - *3. READ .MP3
& .WMA EXTENDED FILE PROPERTIES*
'- *3. MAKES PROPERTY CELLS BLUE
'- ONLY EXTRACTS FILE DATA SO CAN BE USED ON ITS OWN. SHEETS CAN BE SAVED AS
NORMAL
'- CAN THEN RUN MACRO "WRITE_TO_EXPLORER" (in another module below) TO
*CHANGE* PROPERTIES
'- Uses Windows Shell32.dll (Requires Tools/References .. 'Microsoft Shell
Controls And Automation')
'- Brian Baulsom July 2007 - using Excel 2000/Windows XP
'
==========================================================================================================
'- Method (works on all files in a single folder)
'- 1. Run macro "READ_FROM_EXPLORER" below TO GET FILE NAMES INTO CURRENTLY
ACTIVE WORKSHEET
'- 2. Manually amend file details in the worksheet.Delete or hide rows for
files not changed saves time(can be left)
'- 3. Run macro "WRITE_TO_EXPLORER" (other module)
'===========================================================================================================
Option Base 1 ' MyProperties(15) starts 1 instead of 0
Dim MyFilePathName As String ' Local variable full path & file name
Public MyPathName As String ' **Public variable |enables 'Sub
GetPathFileNameFromFullPath()'|
Public MyFileName As String ' **Public variable |usage in
'WRITE_TO_EXPLORER' macro |
'- Properties Array (list of integers)
Dim Arr1 As Variant ' "Name"= shell property zero + First 5
properties in Windows Explorer
Dim Arr2 As Variant ' some more shell GetDetailsOf()
property numbers (0-34 available. 3 unused)
Dim MyProperties(16) As Integer ' Shell property index numbers used
here. Puts them in required order
Dim MyPropertyNum As Integer ' Array item position 1-15
Dim MyPropertyVal As Variant ' Lookup Array data shell property
numbers 0,16, 17 ... etc.
'-
Dim ws As Worksheet
Dim ToRow As Long ' write to worksheet row number
'- Shell variables
Dim ShellObj As Shell
Dim MyFolder As Folder
Dim MyFolderItem As FolderItem
'-
'===========================================================================================================
'- MAIN ROUTINE
'===========================================================================================================
Sub READ_FROM_EXPLORER()
Application.EnableEvents = False ' WORKSHEET Worksheet_Change() makes
changed cells yellow
'-------------------------------------------------------------------------------------------------------
'- GET FOLDER NAME FROM FIRST FOLDER\FILE IN THE WORKSHEET
MyFilePathName = ActiveSheet.Range("O2").Value
If InStr(1, MyFilePathName, "\", vbTextCompare) <> 0 Then 'there is "\"
in the path
GetPathFileNameFromFullPath (MyFilePathName) ' PUBLIC SUBROUTINE
IN 'READ_FROM_EXPLORER' module
ChDrive MyPathName
ChDir MyPathName & "\"
Else
ChDrive ThisWorkbook.FullName
ChDir ThisWorkbook.FullName
End If
'- GET FOLDER - Method 1 - using Windows Dialog (comment out if not
required)
'MsgBox ("Selecting a single file in the following dialog gets the
required *FOLDER*." & vbCr & vbCr _
& "NB. CLEARS THE CURRENTLY ACTIVE SHEET.")
MyFilePathName = _
Application.GetOpenFilename("Audio Files (*.mp3;*.wma),*.mp3;*.wma",
, " GET FOLDER REQUIRED")
If MyFilePathName = "False" Then Exit Sub
GetPathFileNameFromFullPath MyFilePathName ' subroutine to separate
folder & file name
'-------------------------------------------------------------------------------------------------------
' '- GET FOLDER - Method 2 - hard coded for testing (comment out if not
required)
' MyPathName = "C:\TEMP\MP3_TEST" ' SET AS REQUIRED
'=======================================================================================================
Set ShellObj = New Shell
Set MyFolder = ShellObj.Namespace(MyPathName)
'------------------------------------------------------------------------------------------
ChDrive MyPathName
ChDir MyPathName & "\"
Set ws = ActiveSheet
ToRow = 2
With ws.Columns("A:O").Cells
.ClearContents ' clear worksheet
.Interior.ColorIndex = xlNone
End With
ws.Rows.Hidden = False
'-------------------------------------------------------------------------------------------
'- INITIALISE PROPERTY ARRAY. CLEAR & SET UP WORKSHEET
'- Set up array to sort properties into the required order
'- do not change Arr1 (list of changeable fields in Windows Explorer -
used in WRITE macro.)
' "Name", "Artist", "Album", "Year", "Track", "Genre", "Lyrics",
"Title","Comments")
Arr1 = Array(0, 16, 17, 18, 19, 20, 27, 10, 14)
For n = 1 To 9: MyProperties(n) = Arr1(n): Next
'- "Duration", "Size", "Date Modified", "Category", "Author", "Bit
Rate"
Arr2 = Array(21, 9, 12, 3, 1, 22, 33)
For n = 10 To 16: MyProperties(n) = Arr2(n - 9): Next
'-------------------------------------------------------------------------------------------
'- write worksheet header
For n = 1 To 14
ws.Cells(1, n).Value = MyFolder.GetDetailsOf(MyFolder.Items,
MyProperties(n))
Next
With ws
'- "Lyrics" is not included in the Shell properties. I have used a
blank one item 27
.Cells(1, "G").Value = "Lyrics"
'- This is useful for other purposes. eg. to play the track via
macro.
.Cells(1, "O").Value = "Full Name"
.Range("A1:O1").Interior.ColorIndex = 37 ' Dark blue header
End With
'===========================================================================================
'- GET FILE NAMES & PROPERTIES FROM FOLDER
'===========================================================================================
MyFileName = Dir(mypath & "*.*") 'first file name
Do While MyFileName <> ""
'- filter .MP3 & .WMA
If UCase(Right(MyFileName, 3)) = "MP3" Or UCase(Right(MyFileName,
3)) = "WMA" Then
Set MyFolderItem = MyFolder.ParseName(MyFileName)
'--------------------------------------------------------------------
'- properties to worksheet
For MyPropertyNum = 1 To 14
MyPropertyVal = MyFolder.GetDetailsOf(MyFolderItem,
MyProperties(MyPropertyNum))
ws.Cells(ToRow, MyPropertyNum).Value = MyPropertyVal
Next
'---------------------------------------------------------------------
'- add full path\file name (used as lookup by "WRITE_TO_EXPLORER")
ws.Cells(ToRow, 15).Value = MyPathName & "\" & MyFileName
ToRow = ToRow + 1
End If
MyFileName = Dir ' Get next file name
Loop
'-------------------------------------------------------------------------------------------
'- finish
With ws
.Activate
'.UsedRange.Columns.AutoFit
.Range("D1,G1,I1,K1").EntireColumn.Hidden = True
.Range("A1").Select
End With
'-------------------------------------------------------------------------------------------
'- colour editable range -> blue
'-------------------------------------------------------------------------------------------
If ToRow > 2 Then ws.Range("B2:I" &
ws.Range("A2").End(xlDown).Row).Interior.ColorIndex = 34
MsgBox ("Done.")
Application.EnableEvents = True
End Sub
'=========== END OF MAIN ROUTINE
===============================================================
'===============================================================================================
'- SUB TO SEPARATE PATH & FILE NAME FROM FULL NAME
'- puts to Public module level variables 'MyFileName' & 'MyPathName'
'===============================================================================================
Public Sub GetPathFileNameFromFullPath(Nm As String)
For c = Len(Nm) To 1 Step -1
If Mid(Nm, c, 1) = "\" Then
MyFileName = Right(Nm, Len(Nm) - c)
MyPathName = Left(Nm, Len(Nm) - Len(MyFileName) - 1)
Exit Sub
End If
Next
End Sub
'----------------------------------
______________________________________
"Héctor Miguel" wrote:
> .
>
H�ctor Miguel
> intente muchos cambios y no logre un resultado bueno... entonces decidi buscar un poco mas en la web
> y encontre algo que me sirvio. te lo copio..:).. muchas gracias por tu colaboracion
gracias a ti, por compartirlo (pero, en mi caso...) lo tendre que dejar para otra oportunidad :-(
(no encontre en mi sistema instaladas las librerias CDDB*.dll)
saludos,
hector.
__ OP __
nestor...@gmail.com
Juan Español
Estoy interesado en este tema.
Miguel, un gurú de Excel hispano , Héctor Miguel, como firmaba en este
grupo, ya no frecuenta este grupo de Excel. No sé si lo seguirá por los
grupos de google.
He estado echando un vistazo a la publicación del 2009 y al final hay un
código que decía fredy que sí le funcionaba.
Yo he depurado el código de importación de tags desde los ficheros mp3 a
Excel.
funciona para los ficheros de una sola carpeta, voy a intentar modificarle
para que funcione para las subcarpetas.
He cambiado el sentido de la importación para que quede una fila para
fichero.
¿Hasta dónde has llegado tú?
Saludos.-
<nestor...@gmail.com> escribió en el mensaje de noticias
news:77674641-7974-4df2...@googlegroups.com...
dirk.ri...@ajegroup.com
Salu2
El sistema de correo electrónico de Aje, está destinado únicamente para
fines del negocio, cualquier otro uso contraviene las políticas de la
empresa. Toda la información del negocio contenida en este mensaje es
confidencial y de uso exclusivo de Aje; su divulgación, copia y/o
adulteración están prohibidas bajo responsabilidad y sólo debe ser conocida
por la persona a quien se dirige este mensaje. Si Ud. ha recibido este
mensaje por error por favor proceda a eliminarlo y notificar al remitente.