Attribute VB_Name = "Módulo1"
Function entorno(cadena)
    
    cadena = UCase$(Trim$(cadena))
    indice = 1
    SALIDA = ""
    Do
        ENTCADENA = UCase$(Environ(indice))
        If Left(ENTCADENA, Len(cadena) + 1) = cadena + "=" Then
            SALIDA = Mid$(Trim$(ENTCADENA), Len(cadena) + 2)
        Else
            indice = indice + 1
        End If
    Loop Until SALIDA <> "" Or ENTCADENA = ""
    'If SALIDA = "" Then
        'MsgBox "No esta definida la variable de entorno " + cadena
    'End If
    entorno = SALIDA
    
End Function

Sub recibofactura()
'
' recibofactura Macro
' Macro creada el 16/10/98 por DEC30
'
Dim dato$
Dim dato1$, rutatemporales$, macrofile$, juego$, asunto$, email$

Dim existearchivo
Dim archivo

asunto$ = ""
email$ = ""

juego$ = entorno("JUEGO")
rutatemporales$ = entorno(juego$ + "FTEMPO")
If rutatemporales = "" Then
    rutatemporales$ = entorno("FTEMPO")
End If




macrofile$ = entorno("MACROFILE")
If macrofile$ = "" Then
    macrofile$ = "macros$.$$$"
End If

If macrofile$ <> "macros$.$$$" Then
   
   Set archivo = CreateObject("Scripting.FileSystemObject")
   existearchivo = archivo.fileExists((rutatemporales$ + macrofile$))
     
   If existearchivo = False Then
     macrofile$ = "macros$.$$$"
   End If
End If

Open rutatemporales$ + macrofile$ For Input As 1

Line Input #1, dato$
If Not EOF(1) Then Line Input #1, asunto$
If Not EOF(1) Then Line Input #1, email$
Close 1
dato1$ = WordBasic.[Left$](dato$, Len(dato$) - 4) + ".$2$"


    ActiveDocument.MailMerge.OpenDataSource Name:=dato$, _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _
        :=""
        
    With ActiveDocument.MailMerge
        .MailAsAttachment = False
        .MailAddressFieldName = email$
        .MailSubject = asunto$
        .SuppressBlankLines = True
        .MailFormat = wdMailFormatHTML
        
   If email$ = "" Then .Destination = wdSendToNewDocument Else .Destination = wdSendToEmail
  
        
        
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=True
    End With
     If email$ = "" Then
       ActiveWindow.ActivePane.SmallScroll Down:=2
       Application.WindowState = wdWindowStateMaximize
       ActiveWindow.WindowState = wdWindowStateMaximize
    Else
       Call salir
    End If
    
    
     
    
    
    
End Sub
Sub salir()
'
' salir Macro
' Macro creada el 10/11/98 por laso sl
'

    Application.Quit SaveChanges:=wdDotNoSaveChanges
End Sub
Sub ImprimeYSale()

Dim dato$
Dim dato1$, rutatemporales$, macrofile$, juego$
Dim existearchivo
Dim archivo


juego$ = entorno("JUEGO")
rutatemporales$ = entorno(juego$ + "FTEMPO")
If rutatemporales = "" Then
    rutatemporales$ = entorno("FTEMPO")
End If

macrofile$ = entorno("MACROFILE")
If macrofile$ = "" Then
    macrofile$ = "macros$.$$$"
End If

If macrofile$ <> "macros$.$$$" Then
   
   Set archivo = CreateObject("Scripting.FileSystemObject")
   existearchivo = archivo.fileExists((rutatemporales$ + macrofile$))
     
   If existearchivo = False Then
     macrofile$ = "macros$.$$$"
   End If
End If

Open rutatemporales$ + macrofile$ For Input As 1

Line Input #1, dato$
Close 1
dato1$ = WordBasic.[Left$](dato$, Len(dato$) - 4) + ".$2$"
    Application.WindowState = wdWindowStateMinimize
    ActiveDocument.MailMerge.OpenDataSource Name:=dato$, _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _
        :=""
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .MailAsAttachment = False
        .MailAddressFieldName = ""
        .MailSubject = ""
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute
    End With

    ActiveDocument.PrintOut (Background = True)
    Do
    Call retardo
    Loop Until (Application.BackgroundPrintingStatus = 0)
    Call salir

End Sub

Sub retardo()
Dim inicio, basura
inicio = Timer
    Do
      basura = DoEvents()
    Loop Until Abs(Timer - inicio) > 2
End Sub