Access - Exportar Informes a HTML en una sola hoja

   
Vista:
Imágen de perfil de Alejandro

Exportar Informes a HTML en una sola hoja

Publicado por Alejandro (98 intervenciones) el 01/06/2014 17:41:59
Tengo este comando que me exporta a formato html el cual me envia por correo, el problema esta que e configurado la Pagina en diferente tamano y como quiera me divide el HTML en diferentes pagina la cual lo que quiero es que sea solo en una pagina sin importar el largo.

DoCmd.OutputTo acReport, "Transaciones del dia Enviar por correo", acFormatHTML, CurrentProject.Path & "\Html_send\Transaciones del dia.html"
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

Exportar Informes a HTML en una sola hoja

Publicado por Jefferson (381 intervenciones) el 02/06/2014 00:44:25
Hola Alejandro

Access no hace eso automáticamente.! Exporta si pero divide el html en paginas y crea una especie de vinculo que lo que hace es abrir el siguiente archivo html grabado en la ruta indicada.

Que se puede hacer .? Claro que si.! pero debes conocer bien VBA

Este es un codigo de John Lauer's escrito para tal asignacion (en su momento lo use)

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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
*** BEGIN CODE SAMPLE ***
Function CombineHTMLFiles(theFilename, Work_Folder, Output_Folder) As Integer
 
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim fsoFile
 
Dim checkForFiles As String
'the array below will be for the filenames - and the position in the
'array will be the file number used to open the file
' for the 2nd dim, position 1 is the file number and position 2 is the
actual file contents
Dim theFiles(1 To 99, 1 To 2) As String
Dim counter As Integer
 
counter = 1
 
checkForFiles = Dir(Trim(Work_Folder) & Trim(theFilename) & "*.html")
 
Do Until checkForFiles = ""
theFiles(counter, 1) = checkForFiles
 
Set fsoFile = fso.OpenTextFile(Trim(Work_Folder) & Trim(checkForFiles)
, ForReading)
theFiles(counter, 2) = fsoFile.ReadAll
 
fsoFile.Close
 
counter = counter + 1
 
'now try for another file
checkForFiles = Dir
Loop
 
Dim maxFile As Integer
maxFile = counter - 1
 
Dim outputFile As TextStream
Set outputFile = fso.CreateTextFile(Trim(Output_Folder) & Trim
(theFilename) & ".html", True)
 
If maxFile = 1 Then
 
'do the replaces to cleanup the output HTML formatting
'since Access doesn't save it to look real nice
'(note that this function returns the cleaned up HTML, so we set the
return
' of the function to the variable of the original HTML being sent in)
theFiles(1, 2) = CleanupHTMLFormatting(theFiles(1, 2))
 
'if there is only 1 file then we just write it out
outputFile.Write theFiles(1, 2)
Else
'if there are multiple files then we must parse and rejoin
 
'1st write out the first file without the closing tags
theFiles(1, 2) = CleanupHTMLFormatting(theFiles(1, 2))
outputFile.Write Left(theFiles(1, 2), (InStrRev(theFiles(1, 2),
"</TABLE>") + 9))
 
Dim startPos As Double, endPos As Double
 
'now do any remaining files, with just the actual body stuff
For counter = 2 To maxFile
startPos = InStr(theFiles(counter, 2), "<TABLE ") - 1
endPos = InStrRev(theFiles(counter, 2), "</TABLE>") + 8
 
theFiles(counter, 2) = CleanupHTMLFormatting(theFiles(counter, 2))
 
outputFile.Write Mid(theFiles(counter, 2), startPos, endPos -
startPos)
Next counter
 
'and finally add the closing tags
outputFile.Write "</BODY></HTML>"
 
End If
 
outputFile.Close
 
Set fso = Nothing
 
 
End Function
 
*** END CODE SAMPLE ***
 
Now here is the 2nd function. It is called from the first one
 
*** BEGIN CODE SAMPLE ***
Function CleanupHTMLFormatting(origHTML As String) As String
 
'first, change any ~HTML: insert HR here~ text to an actual HR tag
CleanupHTMLFormatting = Replace(origHTML, "~HTML: insert HR here~", "<HR
size=4 color=black width=100%>")
 
'now, change any ~HTML: insert blank line here~ text to a <BR> tag
CleanupHTMLFormatting = Replace(CleanupHTMLFormatting, "~HTML: insert
blank line here~", "<BR>")
 
'get rid of any <a href... tags since they are the Next Page, Prev Page,
etc links that we don't need
Dim myRegExp As RegExp
Set myRegExp = New RegExp
 
myRegExp.Pattern = "<a href.*</a>"
myRegExp.Global = True
myRegExp.IgnoreCase = True
myRegExp.Multiline = True
 
CleanupHTMLFormatting = myRegExp.Replace(CleanupHTMLFormatting, "")
 
Set myRegExp = Nothing
 
CleanupHTMLFormatting = Fix_Subtotal_Alignment(CleanupHTMLFormatting)
 
End Function
*** END CODE SAMPLE ***
 
*** BEGIN CODE SAMPLE ***
Function Fix_Subtotal_Alignment(theText)
 
Dim CRLF
CRLF = Chr(13) & Chr(10)
 
Dim startPos, endPos, startBlock, endBlock
Dim foreText, oldText, newText, postText
 
Dim objRegExpr, colMatches, objMatch
 
startPos = 1
 
Do While InStr(startPos, theText, "~HTML:start total row~") > 0
 
startPos = InStr(startPos, theText, "~HTML:start total row~")
endPos = InStr(startPos, theText, "~HTML:end total row~")
startBlock = InStrRev(theText, "<TABLE", startPos) - 1
endBlock = InStr(endPos, theText, "</TABLE>") + 8
 
foreText = Left(theText, startBlock - 1)
postText = Right(theText, (Len(theText) - endBlock))
oldText = Mid(theText, startBlock, (endBlock - startBlock))
 
Set objRegExpr = New RegExp
 
objRegExpr.Pattern = "COLOR=#000000>.*</FONT>"
objRegExpr.Global = True
objRegExpr.IgnoreCase = True
 
Set colMatches = objRegExpr.Execute(oldText)
 
newText = "<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0 >" & CRLF &
"<TR HEIGHT=14>" & CRLF
newText = newText & "<TD WIDTH=64 ALIGN=LEFT > <BR></TD><TD
WIDTH=500 ALIGN=RIGHT ><FONT style=FONT-SIZE:8pt FACE=""Arial""
COLOR=#000000>"
newText = newText & Mid(colMatches(0).Value, 15, Len(colMatches(0).
Value) - 21) & "</FONT></TD>" & CRLF
newText = newText & "<TD WIDTH=40 ALIGN=RIGHT ><FONT style=FONT-SIZE:
8pt FACE=""Arial"" COLOR=#000000>"
newText = newText & Mid(colMatches(1).Value, 15, Len(colMatches(0).
Value) - 21) & "</FONT></TD>" & CRLF
newText = newText & "<TD WIDTH=96 ALIGN=RIGHT ><FONT style=FONT-SIZE:
8pt FACE=""Arial"" COLOR=#000000>"
newText = newText & Mid(colMatches(2).Value, 15, Len(colMatches(0).
Value) - 21) & "</FONT></TD>" & CRLF
newText = newText & "</TR>" & CRLF & "</TABLE>" & CRLF
 
 
theText = foreText & newText & postText
 
startPos = startPos + 20
Set colMatches = Nothing
Set objRegExpr = Nothing
Loop
 
Fix_Subtotal_Alignment = theText
 
End Function
 
*** END CODE SAMPLE ***


Luego me decante por sacarlo de una consulta en tiempo de ejcucion, Obviamente el Informe "Transaciones del dia Enviar por correo" debe nacer de una tabla o consulta

http://www.lawebdelprogramador.com/foros/Access/1389033-Enviar_datos_por_mail_pero_no_adjunto_sino_en_detalle.html

Desde Venezuela
Jefferson Jimenez
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
Imágen de perfil de Alejandro

Exportar Informes a HTML en una sola hoja

Publicado por Alejandro (98 intervenciones) el 02/06/2014 05:29:52
Gracias JJJT yo le agradezco inmensidad a usted y a neckito. Gracias a ustedes termine mi proyecto y me quedo perfecto aunque siempre le pongo cosas nuevas... en mi proyecto tienen un espacio los dos y este foro donde le doi su créditos u las gracias
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