Quiero consulta de código por error en la llamada a una variable que contiene un nombre de archivo

ESTE ES EL CODIGO QUE TENGO, PERO AL MOMENTO DE LLAMAR LA VARIABLE QUE TIENE CONTENIDO EL NOMBRE DEL SIGUIENTE ARCHIVO, ME MARCA UN ERROR
ERROR 9: SUBSCRIPT OUT OF RANGE
Sub Actualiza()
Call ListFiles("D:\RAUL VELARDE Y MENDEZ", "*.xls")
End Sub
Sub ProcesaArchivos(nombre As String)
Dim col, num As Long
Dim FilePath As String
num = 1
FilePath = "D:\RAUL VELARDE Y MENDEZ\"
nombre = num & "DICIEMBRE2009LPG.xls"
coleccion = FilePath & nombre
num = num + 1
Workbooks.Open Filename:=coleccion, UpdateLinks:=0
col = 40
Range("T24:T33").Select
Selection.Copy
Windows("PruebaEstdic2009.xls").Activate
Sheets("DBDIC2009").Select
Cells(12, col).Select
col = col + 1
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, operation:=xlNone, skipblanks _
        :=False, Transpose:=False
Windows(strTemp).Activate      "AQUI ME MARCA EL ERROR"
ActiveWindow.Close
End Sub
Public Function ListFiles(strPath As String, Optional strFileSpec As String, _
Optional bIncludeSubfolders As Boolean, Optional lst As ListBox)
On Error GoTo Err_Handler
'Purpose: List the files in the path.
'Arguments: strPath = the path to search.
' strFileSpec = "*.*" unless you specify differently.
' bIncludeSubfolders: If True, returns results from subdirectories of strPath as well.
' lst: if you pass in a list box, items are added to it. If not, files are listed to immediate window.
' The list box must have its Row Source Type property set to Value List.
'Method: FilDir() adds items to a collection, calling itself recursively for subfolders.
Dim colDirList As New Collection
Dim varItem As Variant
Call FillDir(colDirList, strPath, strFileSpec, bIncludeSubfolders)
'Add the files to a list box if one was passed in. Otherwise list to the Immediate Window.
If lst Is Nothing Then
    For Each varItem In colDirList
    Debug.Print varItem
    Next
Else
    For Each varItem In colDirList
    lst.AddItem varItem
    Next
End If
Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume Exit_Handler
End Function
Private Function FillDir(colDirList As Collection, ByVal strFolder As String, strFileSpec As String, _
bIncludeSubfolders As Boolean)
'Build up a list of files, and then add add to this list, any additional folders
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
Dim nombre As String
'Add the files to the folder.
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
    nombre = strTemp
    colDirList.Add strFolder & strTemp
    strTemp = Dir
    Call ProcesaArchivos(nombre)
Loop
If bIncludeSubfolders Then
'Build collection of additional subfolders.
    strTemp = Dir(strFolder, vbDirectory)
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
    If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0& Then
    colFolders.Add strTemp
    End If
End If
    strTemp = Dir
Loop
'Call function recursively for each subfolder.
For Each vFolderName In colFolders
    Call FillDir(colDirList, strFolder & TrailingSlash(vFolderName), strFileSpec, True)
    Next vFolderName
End If
End Function
Public Function TrailingSlash(varIn As Variant) As String
If Len(varIn) > 0& Then
    If Right(varIn, 1&) = "\" Then
    TrailingSlash = varIn
Else
    TrailingSlash = varIn & "\"
    End If
End If
End Function

1 respuesta

Respuesta
-1
Veo que lo que tienes es una macro en visual, pero creo que seria mas facil si en el mismo libro en el que tienes tus productos agregues una hoja temporal en la que copies los productos del proveedor y las operaciones se hagan en el mismo libro.
Para que no tengas que abrir, copiar y pegar la informacion, digo esto lo puedes hacer de manera manual y te podrias evitar muchos problemas.
De otra forma me seria mas facil si me facilitas el archivo, pues con solo ver el codigo no puedo hacer pruebas, suerte¡

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas