Como exporto el libro poniéndole contraseña
Ahora, necesito en algún lugar ponerle que exporte el libro a Excel con una contraseña determinada, para que al abrirlo la solicite, y no he encontrado donde ponerlo, pudiera ayudarme. Le copio el código:
Private Sub cmdExportar_Click()
Dim rstNombrePrograma As DAO.Recordset, _
rstTituloTema As DAO.Recordset, _
qdf As DAO.QueryDef, _
strSQL As String, _
strHoja As String, _
strArchivo As String, _
strTitulo As String, _
Campo As DAO.Field, _
lngColumna As Long, _
i As Long, _
xls As Object
Const xlWBATWorksheet = -4167
Const xlAutomatic = -4105
Const xlSolid = 1
Const xlThemeColorDark1 = 1
Const xlToRight = -4161
Const xlNormal = -4143
On Error GoTo cmdExportar_Click_TratamientoErrores
strSQL = "SELECT NombrePrograma"
strSQL = strSQL & " FROM ProgramasEmitidos"
strSQL = strSQL & " GROUP BY NombrePrograma"
Set xls = CreateObject("Excel.Application")
xls.Visible = True
xls.Workbooks.Add xlWBATWorksheet
strHoja = xls.ActiveSheet.Name
Set rstNombrePrograma = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
If Not (rstNombrePrograma.EOF And rstNombrePrograma.BOF) Then
Do
StrSQL = "SELECT TituloTema, NombreAutor, NombreInterprete, Sonatas, Fecha, Calculo, Local, Plantilla "
strSQL = strSQL & "FROM ProgramasEmitidos"
strSQL = strSQL & " WHERE NombrePrograma = Parametro1"
Set qdf = CurrentDb.CreateQueryDef("", strSQL)
qdf.Parameters("Parametro1") = rstNombrePrograma!NombrePrograma
Set rstTituloTema = qdf.OpenRecordset
xls.ActiveWorkBook.Sheets.Add Before:=xls.Worksheets(xls.Worksheets.Count)
xls.ActiveSheet.Name = rstNombrePrograma!NombrePrograma
With xls
lngColumna = 1
For Each Campo In rstTituloTema.Fields
strTitulo = ""
For i = 1 To Len(Campo.Name)
strTitulo = strTitulo & Mid(Campo.Name, i, 1)
If i < Len(Campo.Name) Then
If EsMayuscula(Mid(Campo.Name, i + 1, 1)) Then strTitulo = strTitulo & " "
End If
Next i
.ActiveSheet.Cells(1, lngColumna) = strTitulo
lngColumna = lngColumna + 1
Next Campo
.Range("A1").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
.Selection.Font.Bold = True
With .Selection.Interior
.Pattern = xlSolid
.ColorIndex = 15
End With
End With
If Not (rstTituloTema.EOF And rstTituloTema.BOF) Then
xls.ActiveSheet.Cells(2, 1).CopyFromRecordset rstTituloTema
End If
xls.Columns("A:G").EntireColumn.AutoFit
rstNombrePrograma.MoveNext
Loop Until rstNombrePrograma.EOF
End If
xls.Application.DisplayAlerts = False
xls.ActiveWorkBook.Worksheets(strHoja).Delete
strArchivo = "D:\SG RADIO\EXPORTACIONES\" & DLookup("Emisora", "01TNomencladorEmisora") & " Derecho Autor Obras Completas.xls"
If Not Nz(strArchivo, "") = "" Then
xls.ActiveWorkBook.SaveAs FileName:=strArchivo, FileFormat:=xlNormal
Else
xls.ActiveWorkBook.Saved = True
End If
xls.Application.DisplayAlerts = True
cmdExportar_Click_Salir:
On Error Resume Next
xls.Quit
Set xls = Nothing
Set qdf = Nothing
CierraRecordsetDAO rstNombrePrograma
CierraRecordsetDAO rstTituloTema
On Error GoTo 0
Exit Sub
cmdExportar_Click_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: cmdExportar_Click de Documento VBA: Form_frmFrmIniCaptacion (" & Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume cmdExportar_Click_Salir
Resume Next
End Sub
1 Respuesta
Carlos, quizás este foro no sea el más idóneo para tu necesidad, tal vez empaquetarlo con un compresor y que solicitase contraseña para abrirlo seria más fácil de lograr (y menos pesado para su envío por correo).
Amigo, ya este código usted lo vio porque me ayudo a extraer en el, de una tabla, el código emisora que lleva por nombre el libro de Excel cuando es exportado, le voy a copiar su última respuesta:
_____
Carlos, no tengo interés (que agradezco) de figurar en parte alguna, si de verdad quieres agradecerme algo, simplemente demuestra que no he perdido el tiempo y has aprendido algo.
Ese código debería utilizarse en la base (aplicación) en donde se han de consolidar los datos, esto es:
Donde estén/existan las tablas que han de recibir los datos de las diferentes consultas.
En la línea que comienza con Temp_Nombre = ...... añadir un paréntesis de cierre al final
Temp_Nombre = Dir(Const_Ubicacion & “Estadistica” & NFic & “ * .Html”)
En la línea que sale en rojo hay que eliminar un espacio en el nombre de la variable
DoCmd.TransferText acImportHTML, , Temp_Destino, Const_Ubicacion & Temp_Nombre, True
(Tendré que modificar el método de transferir código al foro).
Los datos se transfieren a la carpeta que corresponda en cada vuelta del bucle, su nombre se 'genera' aquí:
Temp_Destino = “TEstadistica” & NFic
Por lo que la variable tomara el valor de NFic (1 .....7)
En la primera vuelta (NFic =1) ===>>>Temp_Destino = “TEstadistica1”
En la segunda vuelta (NFic =2) ===>>>Temp_Destino = “TEstadistica2”
Y se repite hasta finalizar el bucle
La función DIR() es muy interesante, la primera vez se le da la ruta completa
Si se repite la llamada (sin la ruta) devuelve el siguiente fichero que (en la misma ubicación) cumpla las condiciones y cuando no encuentra más.. devuelve una cadena vacía (que es cuando NFic pasa de uno a dos, tres ...)
Y en cada cambio de NFic:
Temp_Nombre = Dir(Const_Ubicacion & “Estadistica” & NFic & “ * .Html”)
Se repite el cambio de numero (NFic) por lo que ...
Temp_Nombre = Dir("D:\SG RADIO CONS\EXPORTACIONES RECIBIDAS\Estadistica1 * .Html”)
El asterisco (*) le permite que reciba el de la 'emisora uno' (o la marca diferencial que se le añada y después al siguiente ... mientras existan ficheros que comiencen por "Estadistica1".
Cuando NFic cambia a 2 y se repite para los que comienzan por "Estadistica2".
Finaliza cuando el bucle llegue a siete ("Estadistica7") y DIR devuelva una cadena de texto vacía.
Solo un consejo: Ojo con los dedos sensibles, con la metodología que aplicas (los datos no recuerdan su origen) se insertaran (duplicaran, triplicaran ...) tantas veces como 'dedo sensible' haga un click en la importación ... de los mismos datos.
_____
Después de esta otra aclaración:
____
quí me dice que no coinciden los tipos
If NFic = "" Then Exit Do
realmente min conocimientos hasta hora no me habían llevado a utilizar este tipo de funciones que usted me ha enseñado o mostrado, soy aprendiz como le dije.
En cuanto a los dedos sensibles el formulario donde está ubicado el botón tiene AlAbrir:
Private Sub Form_Open(Cancel As Integer)
DoCmd.SetWarnings (False)
DoCmd.OpenQuery "VaciarTablaEstadistica1"
DoCmd.OpenQuery "VaciarTablaEstadistica2"
DoCmd.OpenQuery "VaciarTablaEstadistica3"
DoCmd.OpenQuery "VaciarTablaEstadistica4"
DoCmd.OpenQuery "VaciarTablaEstadistica5"
DoCmd.OpenQuery "VaciarTablaEstadistica6"
DoCmd.OpenQuery "VaciarTablaEstadistica7"
DoCmd.OpenQuery "VaciarTablaInformeACDAM"
DoCmd.OpenQuery "VaciarTablaEstadisticaMusicaInc1"
DoCmd.OpenQuery "VaciarTablaEstadisticaMusicaInc2"
End Sub
por lo que no hay posibilidad de que se dupliquen los datos pues las tablas son vaciadas automáticamene
el 7 may.
Error mío, cambia la línea por esta:
If Temp_Nombre = ”” Then Exit Do
Si los ficheros se borran tras su importación, se puede hacer en el mismo bucle.
Antes de 'Temp_Nombre = Dir' (que obtendría el siguiente fichero) con Kill se borra el actual
Kill (Const_Ubicacion & Temp_Nombre) Temp_Nombre = Dir
el 7 may.
¡Gracias migo! Todo hasta ahora está como necesitaba, voy a cerrar este hilo ya y espero que si necesito algo nuevamente poder contar con su ayuda, se que no necesita reconocimiento, pero era para hacerle saber mi agradecimiento, por acá por Cuba Carlos Reyes Leyva le queda muy agradecido de darme la oportunidad de aprender algo más con Usted. Dios lo bendiga y un abrazo de corazón
____
Ahora lo que necesito es que esa misma exportación que logré como necesitaba, gracias a usted, se haga colocándole una contraseña de apertura al libro, quiero decir, que después de exportado se necesite una contraseña para abrirlo, porque así me lo solicitó el cliente. He intentado hacerlo pero no hayo como. Si me puede ayudar se lo agradecería
Soy y era consciente de que esa exportación era la del archivo Excel, pero mi dominio de Excel no es el mismo que de Access, aunque ambos compartan el lenguaje son diferentes en sus procesos.
Tampoco he visto muchas publicaciones sobre la seguridad, porque una vez que se publica un método se están dando pistas para romperlo.
Publica esta misma duda en el foro especifico (el de Excel) y seguro que obtendrás la respuesta que necesitas o la guía para lograrlo, solo la has publicado en el de Access.
