Modificar macros
Publicado por Alan (3 intervenciones) el 30/05/2018 18:40:16
Hola que tal, tengo una duda, tengo la siguiente macros:
La macros lo que hace es que toma los nombres de archivos de la columna A, luego toma la ruta de la columna B y mueve los archivos de la columna A a la ruta de B, pero para que A funcione, se necesita definir la ruta previamente directamente en el codigo de la macros, tambien, en la columna C se despliega un mensaje de cuando fue movido dicho archivo (con la macros) y si no se pudo mover despliega un mensaje de error para visar que algo anda mal.
Const FolderA = "Z:\Folder A\" ' NOTE trailing backslash ( En esta linea de codigo, se define la ruta de los archivos en la columna A, y esto quiero automatizarlo para que en vez de tener que cambiar manualmente, se puede hacer medianteu un buscar de archivos)
Lo que necesito es que en vez de tener que definir manualmente y modificar la dirección en la macros, se pueda elegir la carpeta que se desea seleccionar desde un seleccionador de archivos, asi mismo que al finalizar de copiar los datos de la columna A a la ruta B, se borren de la ruta original dicho archivo, pero si llega a haber un error, que no sea borrado el archivo y se quede ahi.
No se si me explique
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Public Sub MoveFiles()
' Fang thru source sheet.
' Move any FolderA files (columnA) to dirs in ColumnB
' if they are not already flagged as having been moved in ColumnC.
' This code would work better with a function that ensures the target
' directory actually exists. Just sayin'.
' smac 5 May 2017. 42 years since first job in IT TODAY!!
Const colA = 1Const colB = 2Const colC = 3Const FolderA = "Z:\Folder A\" ' NOTE trailing backslash
Const srcSheet = "Mover Archivos"
Dim xlS As Excel.WorksheetDim xlW As Excel.WorkbookDim RN As Long ' row number
Dim fName As String
Dim fPath As String
' get ready
Set xlW = ActiveWorkbookSet xlS = xlW.Sheets(srcSheet)
RN = 2fName = Trim(xlS.Cells(RN, colA).Text)
' We'll run thru ColA until we hit a blank
On Error Resume Next ' expect problems if no target Dir
While fName <> ""
' if it hasn't aready been moved
If Trim(xlS.Cells(RN, colC).Text) = "" Then
' got one.
' Get the path. Ensure trailing backslash
fPath = Trim(xlS.Cells(RN, colB).Text)
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
' if the target already exists, nuke it.
If Dir(fPath & fName) <> "" Then Kill fPath & fName
' move it
FileCopy FolderA & fName, fPath & fName
DoEvents
' report it
If Err.Number <> 0 Then
xlS.Cells(RN, colC).Value = "Failed: Check target Dir"
Err.ClearElse
xlS.Cells(RN, colC).Value = Now()
End If
End If
' ready for next one
RN = RN + 1
fName = Trim(xlS.Cells(RN, colA).Text)
Wend
MsgBox "Done it!!"End Sub
La macros lo que hace es que toma los nombres de archivos de la columna A, luego toma la ruta de la columna B y mueve los archivos de la columna A a la ruta de B, pero para que A funcione, se necesita definir la ruta previamente directamente en el codigo de la macros, tambien, en la columna C se despliega un mensaje de cuando fue movido dicho archivo (con la macros) y si no se pudo mover despliega un mensaje de error para visar que algo anda mal.
Const FolderA = "Z:\Folder A\" ' NOTE trailing backslash ( En esta linea de codigo, se define la ruta de los archivos en la columna A, y esto quiero automatizarlo para que en vez de tener que cambiar manualmente, se puede hacer medianteu un buscar de archivos)
Lo que necesito es que en vez de tener que definir manualmente y modificar la dirección en la macros, se pueda elegir la carpeta que se desea seleccionar desde un seleccionador de archivos, asi mismo que al finalizar de copiar los datos de la columna A a la ruta B, se borren de la ruta original dicho archivo, pero si llega a haber un error, que no sea borrado el archivo y se quede ahi.
No se si me explique
Valora esta pregunta
0