Excel - Macro que envié correo automaticamente

 
Vista:
sin imagen de perfil
Val: 6
Ha aumentado su posición en 2 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro que envié correo automaticamente

Publicado por Johnny (4 intervenciones) el 18/01/2019 11:38:22
Hola buenas tardes o buenos días a tod@s.

Tengo un problema con esta macro que estoy tratando de hacer, básicamente la función que debe realizar la macro es la siguiente, de un grupo de archivos cargarlos en una plantilla que ya tengo establecida, los clasifique por tipo, es decir que según el nombre del archivo me lo clasifique como tipo (físico o compensado). el programa que me arroja la base de datos tiene la misma estructura, es decir misma columnas, misma descripción de los títulos, pero la diferencia esta en que al momento de darme el archivo me los guarda con nombre distintos, y lo que quiero hacer es que según ese nombre de archivo me los clasifique como tipo Físico o Compensado.

Estas son las estructuras de codigos que tengo.
esta es para cargar los archivos a a mi base de datos, me dijeron que dentro de este mismo código tenia que dar la instrucción pero yo lo dividí en dos.

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
Sub Importar()
 
Dim file As String
Dim xlLibro As Workbook
Dim i As Integer
 
Application.ScreenUpdating = False
 
Worksheets("base").Range("A2:AB65000").ClearContents
 
    fileToopen = Application _
    .GetOpenFilename("Todos los archivos (*.*), *.*")
 
If fileToopen <> False Then
 
    Set xlLibro = Workbooks.Open _
    (fileToopen, True, True, , "")
 
    file = ActiveWorkbook.Name
 
    ActiveSheet.Range("A1:AB65000").Copy
 
    Windows("prueba 5.xlsm").Activate
    Sheets("base").Select
    ActiveSheet.Range("A1").Select
    ActiveSheet.Paste
 
    Application.Workbooks(file).Activate
    ActiveSheet.Range("A1").Select
 
    Application.CutCopyMode = False
 
    ActiveWorkbook.Close (False)
 
    Windows("prueba 5.xlsm").Activate
 
    Sheets("inicio").Select
    Range("A1").Select
 
ActiveWorkbook.RefreshAll
 
End If
 
    Sheets("inicio").Activate
    ActiveSheet.Range("A1").Select
 
MsgBox "Datos Importados Correctamente"
End Sub


Esta otra parte me carga los datos a la plantilla, les da formato numérico a las filas especificas que necesito y copia los datos que solemnemente necesito
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
Sub CyPv()
 
Worksheets("base").Activate
 
    Columns("D:D").Select
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
 
End Sub
Sub EliminarIntermediario()
 
Dim i As Integer
i = 2
Dim j As Integer
 
Do While Worksheets("base").Cells(i, 1) <> ""
i = i + 1
Loop
Ultimo = i - 1
 
For j = Ultimo To 2 Step -1
 
If Worksheets("base").Cells(j, 4) = "No" Then
 
    Worksheets("base").Cells(j, 1).EntireRow.Delete
 
End If
 
Next j
 
End Sub
 
Sub CopiarDatos()
 
Dim i As Integer
i = 2
 
Do While Worksheets("base").Cells(i, 1) <> ""
i = i + 1
Loop
Ultimo = i - 1
 
x = 3
For j = 2 To Ultimo
 
If Worksheets("base").Cells(j, 1) <> "" Then
 
 
    Worksheets("inicio").Cells(x, 3) = Worksheets("base").Cells(j, 4)
    Worksheets("inicio").Cells(x, 4) = Worksheets("base").Cells(j, 6)
    Worksheets("inicio").Cells(x, 5) = Worksheets("base").Cells(j, 8)
    Worksheets("inicio").Cells(x, 6) = Worksheets("base").Cells(j, 9)
    Worksheets("inicio").Cells(x, 7) = Worksheets("base").Cells(j, 10)
 
    x = x + 1
 
End If
 
Next j
 
End Sub
 
Sub FormatoNumeros()
 
Worksheets("inicio").Activate
 
    Range("E3:E21,G3:G21").Select
    Range("G3").Activate
    Selection.NumberFormat = "#,##0.00"
    Range("B2").Select
 
End Sub

esta parte del código que dice EliminarIntermediario no la puedo hacer funcionar, ya que me copia todos los valores de esa y no copia los específicos (nombres de bancos) que necesito.
ojala me puedan ayudar.
en caso de que haga falta subir el archivo me lo hacen saber.
que tengan un buen días

Saludos.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

Macro que envié correo automaticamente

Publicado por Antoni Masana (2477 intervenciones) el 18/01/2019 12:45:06
He reordenado un poco el codigo para verlo mejor y sin ver el libro y siguiendo paso a paso que haced las macros no veo como puedo ayudarte.

Necesito entender que quieres hacer y que hace. viendo el codigo parece todo correcto.

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
80
81
Sub Importar()
    Dim file As String
    Dim xlLibro As Workbook
    Dim i As Integer
    Application.ScreenUpdating = False
    Worksheets("base").Range("A2:AB65000").ClearContents
    fileToopen = Application.GetOpenFilename("Todos los archivos (*.*), *.*")
    If fileToopen <> False Then
        Set xlLibro = Workbooks.Open(fileToopen, True, True, , "")
        file = ActiveWorkbook.Name
        ActiveSheet.Range("A1:AB65000").Copy
        Windows("prueba 5.xlsm").Activate
        Sheets("base").Select
        ActiveSheet.Range("A1").Select
        ActiveSheet.Paste
        Application.Workbooks(file).Activate
        ActiveSheet.Range("A1").Select
        Application.CutCopyMode = False
        ActiveWorkbook.Close (False)
        Windows("prueba 5.xlsm").Activate
        Sheets("inicio").Select
        Range("A1").Select
        ActiveWorkbook.RefreshAll
    End If
    Sheets("inicio").Activate
    ActiveSheet.Range("A1").Select
    MsgBox "Datos Importados Correctamente"
End Sub
 
Sub CyPv()
    Worksheets("base").Activate
    Columns("D:D").Select
    Selection.Copy
    Range("D1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
End Sub
 
Sub EliminarIntermediario()
    Dim i As Integer,  j As Integer
    i = 2
    Do While Worksheets("base").Cells(i, 1) <> ""
       i = i + 1
    Loop
    Ultimo = i - 1
    For j = Ultimo To 2 Step -1
        If Worksheets("base").Cells(j, 4) = "No" Then
           Worksheets("base").Cells(j, 1).EntireRow.Delete
         End If
    Next j
End Sub
 
Sub CopiarDatos()
    Dim i As Integer
    i = 2
    Do While Worksheets("base").Cells(i, 1) <> ""
       i = i + 1
    Loop
    Ultimo = i - 1
    x = 3
    For j = 2 To Ultimo
        If Worksheets("base").Cells(j, 1) <> "" Then
           Worksheets("inicio").Cells(x, 3) = Worksheets("base").Cells(j, 4)
           Worksheets("inicio").Cells(x, 4) = Worksheets("base").Cells(j, 6)
           Worksheets("inicio").Cells(x, 5) = Worksheets("base").Cells(j, 8)
           Worksheets("inicio").Cells(x, 6) = Worksheets("base").Cells(j, 9)
           Worksheets("inicio").Cells(x, 7) = Worksheets("base").Cells(j, 10)
           x = x + 1
        End If
    Next j
End Sub
 
Sub FormatoNumeros()
    Worksheets("inicio").Activate
    Range("E3:E21,G3:G21").Select
    Range("G3").Activate
    Selection.NumberFormat = "#,##0.00"
    Range("B2").Select
End Sub

Por ejemplo el último evento de la lista solo pone formato a G3, si no me equivoco


Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil
Val: 6
Ha aumentado su posición en 2 puestos en Excel (en relación al último mes)
Gráfica de Excel

Macro que envié correo automaticamente

Publicado por Johnny (4 intervenciones) el 18/01/2019 13:21:14
Hola gracias por tomarte un tiempo y tratar de ayudarme con mi problema, como comentaba tengo dos fuentes de archivos en donde tienen el mismo nombre de las columnas, los títulos de las columnas para cada caso son iguales pongo un ejemplo:
1
nem_inv	-----fec_vct_ope ----	rut_cli---- nom_ctr---cod_ope---mon_trs	uni_trs---val_ctb_uni----mon_pre----mnt_fin----val_ctb_mnt

Esos son los nombres de las columnas que identifican los datos, para ambos casos son iguales, lo único diferente son los nombres de los archivos, y lo que trato de hacer es que según ese nombre que los clasifique en la base de datos como "tipo físico o compensado" pero no se como hacerlo.

la parte que dice sub EliminarIntermediario me carga todos los datos, pero eso esta mal ya que solo debe cargar los datos de los bancos para eso cree esa linea de código pero no me funciona bien.

esas son las funciones que realizan estas funciones:
1
2
3
4
5
Call BuscarInter 'Agrega comentario de intermediario
Call CyPv 'Copia y pega valores de intermediarios
Call EliminarIntermediario 'Elimina todo lo que no es intermediario
Call CopiarDatos 'Copia datos en pestaña inicio
Call FormatoNumeros 'Da formato a numeros de pestaña inicio    

podrías ver el libro para ver que estoy haciendo mal.

Muchas gracias de antemano.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar