Envoie de fax d'apres une base de données apisoft

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 553 fois - Téléchargée 29 fois

Commenter

Contenu du snippet

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

A voir également

Ajouter un commentaire

Commentaires

Signaler
mpsi
Messages postés
12
Date d'inscription
lundi 2 décembre 2002
Statut
Membre
Dernière intervention
21 avril 2006
 -
Salut,
Ton Code est interressant, toutefois il serait judicieux de poster ton projet en intégralité...
A+
Gilles
Signaler
EvilGost
Messages postés
235
Date d'inscription
lundi 16 décembre 2002
Statut
Membre
Dernière intervention
16 mai 2011
 2 -
totalement inutile...
il manque pleins de code (comme l'envoi de fax, qui me parait le plus intéressant)....
S'inscrire maintenant

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.