le code est issus d'un probleme de mes clients c'est que apisoft gestion a créer un bonus pour envoyer des fax via le reseau , mais qui ne fonctionne pas
ce programme permet de remplacer le soft d'envoie de fax en me servant de la base de données fax d'apisoft
il contient la lecture de données + l'envoi de fax via l'utilitaire de windows
seul gros probleme c'est que je ne pouvais pas envoyer de fichier .pcx via vb dc j'utilise convert de imagick pour le convertir en jpg
Source / Exemple :
Public fichierA, fichierB, fichierC, Tel, dest, img, cpt, chaine2
Public connect As New DataEnvironment1
Sub envoiefax()
On Error GoTo gesterreur
connect.rsClient.Open
Do Until connect.rsClient.EOF
If connect.rsClient.EOF Then
Form_Load
Else
fichierB = fichierC & connect.rsClient!fichierPCX
Tel = connect.rsClient!numfax
dest = connect.rsClient!nomtiers
Dim x As Printer, hit As Boolean
hit = False
For Each x In Printers
If x.DeviceName = "Fax" Then
Set Printer = x
hit = True
Exit For
End If
Next
If hit = False Then
MsgBox "Il n'y a pas d'imprimante au nom de fax"
End If
SendKeys "{ENTER}"
SendKeys dest
SendKeys "{TAB}{TAB}"
SendKeys Tel
SendKeys "{ENTER}{ENTER}{ENTER}{ENTER}"
Printer.ScaleMode = vbMillimeters
Dim img As StdPicture
Set img = LoadPicture(fichierB)
Printer.PaintPicture img, 0, 0, 210, 297
Printer.EndDoc
connect.rsClient.MoveNext
End If
Loop
connect.rsClient.Close
Exit Sub
gesterreur:
Err = MsgBox("Probleme dans le nomage de vos fichiers, faite 'effacer' et relancer les fax a partir d'apisoft", vbCritical, "Hum!!!!!!")
End Sub
Private Sub cmdactualise_Click()
actualise
End Sub
Sub actualise()
Adodc1.Refresh
DataGrid1.Rebind
modiffichierbase
End Sub
Private Sub cmdenvoyer_Click()
actualise
Call envoiefax
End Sub
Private Sub cmdquitter_Click()
End
End Sub
Private Sub Command1_Click()
On Error GoTo gesterr
purger
connect.rsClient.Close
Kill "c:\apisoft\gest_exp\fic\*"
Exit Sub
gesterr:
Err = MsgBox("Aucun fax a supprimer", vbCritical, "Hum!!!!!!")
End Sub
Private Sub Form_Load()
modiffichierbase
End Sub
Sub modiffichierbase()
cpt = 0
connect.rsClient.Open "select * from listefax"
Do Until connect.rsClient.EOF
cpt = cpt + 1
fichierA = "c:\apisoft\gest_exp\" & connect.rsClient!fichierPCX ' fichier pcx
fichierC = "c:\apisoft\gest_exp\"
chaine = InStr(1, connect.rsClient!fichierPCX, ".", 0)
chaine2 = Left(connect.rsClient!fichierPCX, chaine - 1)
chaine3 = chaine = InStr(1, connect.rsClient!fichierPCX, ".jpg", 0)
chaine4 = Right(connect.rsClient!fichierPCX, 4)
If chaine4 <> ".jpg" Then
Shell "c:\pgr_fax\img\visualmagick\bin\convert" & " " & fichierA & " " & fichierC & chaine2 & cpt & ".jpg", vbHide
connect.rsClient!fichierPCX = chaine2 & cpt & ".jpg"
connect.rsClient.Update
End If
connect.rsClient.MoveNext
Loop
connect.rsClient.Close
End Sub
Sub purger()
connect.rsClient.Open
Do Until connect.rsClient.EOF
connect.rsClient.Delete
connect.rsClient.MoveNext
Loop
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.