Guardar en dos carpetas de access a excel
Para Jacinto Trillo
Buenos días hace tiempo me ayudaste con un código para exportar desde access a excel.
Hoy funciona perfecto! Te pido si me podes ayudar con algo.
Necesito que me guarde el archivo en dos carpetas. ¿Es posible?
Te paso el código que utilizo.
Muchas gracias
Private Sub Exportar_Click() Dim RutaExport As String, LlibreExport As String, Fitxer As String, Consulta As String, StrSQL As String, CampoCliente As String, CampoNOMBRE As String, CampoNumero As String Dim Rst As DAO.Recordset StrSQL = "SELECT * FROM ExportarExcel;" Set Rst = CurrentDb.OpenRecordset(StrSQL, dbOpenSnapshot) If Not Rst.EOF And Not Rst.BOF Then Rst.MoveLast Rst.MoveFirst CampoCliente = Rst!Cliente CampoNOMBRE = Rst!Nombre CampoNumero = Rst!Numero Else MsgBox "La consulta que intentas exportar no devuelve Registros", vbCritical, "FALTAN DATOS" End If RutaExport = "C:\Ordenes de Fact\_Respaldo\" ' Ruta de donde quieres poner el excel LlibreExport = "Orden" & " " & CampoCliente & CampoNOMBRE & CampoNumero & " " & Format(Now, "dd-mm-yyyy") + Format(Now, "(hh'mm)") & ".xls" Fitxer = RutaExport & LlibreExport Consulta = "ExportarExcel" ' Lo que quieres exportar If Application.Version = "12.0" Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, Consulta, Fitxer Else DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Consulta, Fitxer End If Rst.Close Set Rst = Nothing End Sub
1 Respuesta
Respuesta de Jacinto Trillo Jareño
2
Es cuestión de declarar una Nueva Ruta y como consecuencia un nuevo fichero, como una solución fácil, con lo que el código quedaría así. Creo no olvidar nada.
Private Sub Exportar_Click() Dim RutaExport As String, LlibreExport As String, Fitxer As String Dim RutaExport2 As String, Fitxer2 As String Dim Consulta As String, StrSQL As String Dim CampoCliente As String, CampoNOMBRE As String, CampoNumero As String Dim Rst As DAO.Recordset StrSQL = "SELECT * FROM ExportarExcel;" Set Rst = CurrentDb.OpenRecordset(StrSQL, dbOpenSnapshot) If Not Rst.EOF And Not Rst.BOF Then Rst.MoveLast Rst.MoveFirst CampoCliente = Rst!Cliente CampoNOMBRE = Rst!Nombre CampoNumero = Rst!Numero Else MsgBox "La consulta que intentas exportar no devuelve Registros", vbCritical, "FALTAN DATOS" End If RutaExport = "C:\Ordenes de Fact\_Respaldo\" ' Ruta de donde quieres poner el excel RutaExport2 = "C:\LaRutaquenecesites........\" LlibreExport = "Orden" & " " & CampoCliente & CampoNOMBRE & CampoNumero & " " & Format(Now, "dd-mm-yyyy") + Format(Now, "(hh'mm)") & ".xls" Fitxer = RutaExport & LlibreExport Fitxer2 = RutaExport2 & LlibreExport Consulta = "ExportarExcel" ' Lo que quieres exportar If Application.Version = "12.0" Then DoCmd. TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, Consulta, Fitxer DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, Consulta, Fitxer2 Else DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Consulta, Fitxer DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, Consulta, Fitxer2 End If Rst.Close Set Rst = Nothing End Sub
Doy por supuesto que el Nombre del Fichero lo conservas. Un saludo >> Jacinto
