Merci beaucoup pour vos reponses,
je vous poste tout mon code en esperant trouver une solution.
Imports System.IO
Imports System.Diagnostics
Imports System.Web.mail
Public Class frmPrinc
Inherits System.Windows.Forms.Form
'variable initial fichier config.ini
Private email As String
Private watchfolder As FileSystemWatcher
#Region " Code généré par le Concepteur Windows Form "
Public Sub New()
MyBase.New()
'Cet appel est requis par le Concepteur Windows Form.
InitializeComponent()
'Ajoutez une initialisation quelconque après l'appel InitializeComponent()
End Sub
'La méthode substituée Dispose du formulaire pour nettoyer la liste des composants.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Requis par le Concepteur Windows Form
Private components As System.ComponentModel.IContainer
'REMARQUE : la procédure suivante est requise par le Concepteur Windows Form
'Elle peut être modifiée en utilisant le Concepteur Windows Form.
'Ne la modifiez pas en utilisant l'éditeur de code.
Friend WithEvents lbConsole As System.Windows.Forms.ListBox
Friend WithEvents txtwatch As System.Windows.Forms.RichTextBox
Friend WithEvents Timer1 As System.Windows.Forms.Timer
Friend WithEvents Timer2 As System.Windows.Forms.Timer
Friend WithEvents st As System.Windows.Forms.StatusBar
Friend WithEvents stPending As System.Windows.Forms.StatusBarPanel
Friend WithEvents stHeure As System.Windows.Forms.StatusBarPanel
Friend WithEvents MainMenu1 As System.Windows.Forms.MainMenu
Friend WithEvents MenuItem1 As System.Windows.Forms.MenuItem
Friend WithEvents MenuItem2 As System.Windows.Forms.MenuItem
Friend WithEvents MenuItem3 As System.Windows.Forms.MenuItem
Friend WithEvents MenuItem4 As System.Windows.Forms.MenuItem
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.components = New System.ComponentModel.Container
Me.lbConsole = New System.Windows.Forms.ListBox
Me.txtwatch = New System.Windows.Forms.RichTextBox
Me.Timer1 = New System.Windows.Forms.Timer(Me.components)
Me.Timer2 = New System.Windows.Forms.Timer(Me.components)
Me.st = New System.Windows.Forms.StatusBar
Me.stPending = New System.Windows.Forms.StatusBarPanel
Me.stHeure = New System.Windows.Forms.StatusBarPanel
Me.MainMenu1 = New System.Windows.Forms.MainMenu
Me.MenuItem1 = New System.Windows.Forms.MenuItem
Me.MenuItem2 = New System.Windows.Forms.MenuItem
Me.MenuItem3 = New System.Windows.Forms.MenuItem
Me.MenuItem4 = New System.Windows.Forms.MenuItem
CType(Me.stPending, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.stHeure, System.ComponentModel.ISupportInitialize).BeginInit()
Me.SuspendLayout()
'
'lbConsole
'
Me.lbConsole.BackColor = System.Drawing.Color.Black
Me.lbConsole.Font = New System.Drawing.Font("Courier New", 10.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.lbConsole.ForeColor = System.Drawing.Color.Chartreuse
Me.lbConsole.ItemHeight = 16
Me.lbConsole.Location = New System.Drawing.Point(8, 8)
Me.lbConsole.Name = "lbConsole"
Me.lbConsole.Size = New System.Drawing.Size(648, 180)
Me.lbConsole.TabIndex = 0
'
'txtwatch
'
Me.txtwatch.BackColor = System.Drawing.Color.Black
Me.txtwatch.Font = New System.Drawing.Font("Lucida Console", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte))
Me.txtwatch.Location = New System.Drawing.Point(8, 192)
Me.txtwatch.Name = "txtwatch"
Me.txtwatch.Size = New System.Drawing.Size(648, 176)
Me.txtwatch.TabIndex = 2
Me.txtwatch.Text = ""
'
'Timer1
'
Me.Timer1.Enabled = True
Me.Timer1.Interval = 600000
'
'Timer2
'
Me.Timer2.Enabled = True
Me.Timer2.Interval = 1000
'
'st
'
Me.st.Location = New System.Drawing.Point(0, 376)
Me.st.Name = "st"
Me.st.Panels.AddRange(New System.Windows.Forms.StatusBarPanel() {Me.stPending, Me.stHeure})
Me.st.ShowPanels = True
Me.st.Size = New System.Drawing.Size(664, 22)
Me.st.TabIndex = 3
'
'stPending
'
Me.stPending.Alignment = System.Windows.Forms.HorizontalAlignment.Right
Me.stPending.Width = 540
'
'stHeure
'
Me.stHeure.Width = 124
'
'MainMenu1
'
Me.MainMenu1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MenuItem1})
'
'MenuItem1
'
Me.MenuItem1.Index = 0
Me.MenuItem1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MenuItem2, Me.MenuItem3, Me.MenuItem4})
Me.MenuItem1.Text = "Fichier"
'
'MenuItem2
'
Me.MenuItem2.Index = 0
Me.MenuItem2.Text = "Propriétés..."
'
'MenuItem3
'
Me.MenuItem3.Index = 1
Me.MenuItem3.Text = "-"
'
'MenuItem4
'
Me.MenuItem4.Index = 2
Me.MenuItem4.Text = "Quitter"
'
'frmPrinc
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(664, 398)
Me.Controls.Add(Me.st)
Me.Controls.Add(Me.txtwatch)
Me.Controls.Add(Me.lbConsole)
Me.Menu = Me.MainMenu1
Me.Name = "frmPrinc"
Me.Text = "Console"
CType(Me.stPending, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.stHeure, System.ComponentModel.ISupportInitialize).EndInit()
Me.ResumeLayout(False)
End Sub
#End Region
Private Sub frmPrinc_Load(ByVal senderer As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
fct_init_app()
fct_watch_folder()
fct_send_mail(envoyeur, warning, "ERREUR PO OUVERT ", 0, "C'est beau arrêtez de capoter, je suis rouvert!!!!", "none")
End Sub
Private Sub fct_init_app()
'initialisation des variables du fichier config.ini
Dim i As Integer
Dim sFiles() As String
Try
Dim FreeF As Integer
Dim str() As String
Dim val() As String
Dim app As Application
Dim tmp() As String
FreeF = FreeFile() 'Possibilité de mettre 1************
FileOpen(FreeF, app.StartupPath & "\config.ini", OpenMode.Input) 'Ouverture du fichier config.ini****
str = Split(InputString(FreeF, FileLen(app.StartupPath & "\config.ini")), Chr(13)) 'Séparation des lignes du fichier***
FileClose(FreeF) 'Fermeture du fichier***************
'assignation des variables
val = Split(str(0), ":")
envoyeur = val(1)
val = Split(str(1), ":")
warning = val(1)
val = Split(str(2), ":")
f_in = val(1)
val = Split(str(3), ":")
f_out = val(1)
val = Split(str(4), ":")
layout_e = val(1)
val = Split(str(5), ":")
layout_f = val(1)
val = Split(str(6), ":")
smtp = val(1)
val = Split(str(7), ":")
signature = val(1)
val = Split(str(8), ":")
archive = val(1)
val = Split(str(9), ":")
server = val(1)
val = Split(str(10), ":")
bd = val(1)
val = Split(str(11), ":")
usr = val(1)
val = Split(str(12), ":")
pwd = val(1)
'************À supprimer pour service*******************************
lbConsole.Items.Add("Sender : " & envoyeur)
lbConsole.Items.Add("Warning : " & warning)
lbConsole.Items.Add("Folder in : " & f_in)
lbConsole.Items.Add("Folder out : " & f_out)
lbConsole.Items.Add("Layout en : " & layout_e)
lbConsole.Items.Add("Layout fr : " & layout_f)
lbConsole.Items.Add("Smtp : " & smtp)
lbConsole.Items.Add("Serveur BD : " & server)
lbConsole.Items.Add("Database : " & bd)
lbConsole.Items.Add("User BD : " & usr)
lbConsole.Items.Add("Pwd BD : " & pwd)
'*******************************************************************
If Not File.Exists(f_in & "\pomail.lock") Then
' pour avoir les noms des fichiers et des sous-répertoires
sFiles = Directory.GetFiles(f_in)
For i = 0 To sFiles.GetUpperBound(0)
If InStr(sFiles(i), ".txt") > 0 Then
FreeF = FreeFile() 'Possibilité de mettre 1************
FileOpen(FreeF, sFiles(i), OpenMode.Input) 'Ouverture du fichier créé**********
str = Split(InputString(FreeF, FileLen(sFiles(i))), Chr(10)) 'Séparation des lignes du fichier***
FileClose(FreeF)
File.Delete(archive & sFiles(i).Substring(27, sFiles(i).Length - 27))
File.Move(sFiles(i), archive & sFiles(i).Substring(27, sFiles(i).Length - 27))
With txtwatch
.SelectionStart = Len(txtwatch.Text)
.SelectionProtected = False
.SelectionStart = Len(txtwatch.Text) + 1
.SelectionColor = System.Drawing.Color.Red
.SelectedText = "Fichier créé : " & Replace(sFiles(i), f_in, "") & " " & Date.Now & vbCrLf
.SelectionProtected = True
.Focus()
.SelectionStart = txtwatch.Text.Length
.ScrollToCaret()
End With
tmp = Split(Replace(Replace(str(0), Chr(34), ""), "'", " "), ";")
If tmp(2).ToUpper = "V" Then
fct_fill_sql(str, sFiles(i).Substring(27, 2).ToUpper)
fct_fill_excel(str, sFiles(i).Substring(27, 2).ToUpper)
End If
End If
If File.Exists(f_in & "\pomail.lock") Then Exit For
Next
End If
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & Replace(sFiles(i), f_in, ""), 0, ex.ToString, "none")
'# erreur no 1
fct_exec_sql("UPDATE pur_order SET err=1 WHERE pur_order.po_number='0'")
End Try
End Sub
Private Sub fct_wait_sec(ByVal ms_to_wait As Long)
Try
Dim endwait As Double
endwait = Environment.TickCount + ms_to_wait
'Atttend x milliseconde le temps que UNIX libère le fichier
While Environment.TickCount < endwait
System.Threading.Thread.Sleep(1)
Application.DoEvents()
End While
Catch ex As Exception
'# erreur no 2
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL", 0, ex.ToString, "none")
End Try
End Sub
Private Sub fct_watch_folder()
Try
'Instanciation du watchfolder
watchfolder = New System.IO.FileSystemWatcher
'f_in est le répertoire où UNIX dump les infos pour les PO
watchfolder.Path = f_in
'Filtre de notification de changement dans le répertoire
watchfolder.NotifyFilter = IO.NotifyFilters.DirectoryName
watchfolder.NotifyFilter = watchfolder.NotifyFilter Or IO.NotifyFilters.FileName
watchfolder.NotifyFilter = watchfolder.NotifyFilter Or IO.NotifyFilters.Attributes
'Ajout d'un évènement sur un fichier créé
AddHandler watchfolder.Created, AddressOf fct_in_info
'Propriété a True pour commencé la surveillance
watchfolder.EnableRaisingEvents = True
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL", 0, ex.ToString, "none")
'# erreur no 3
End Try
End Sub
Private Sub fct_in_info(ByVal source As Object, ByVal e As System.IO.FileSystemEventArgs)
Try
'Vérification création de fichier
If e.ChangeType = IO.WatcherChangeTypes.Created Then
'************À supprimer pour service*******************************
'lbWatch.Items.Add("Fichier créé : " & e.Name)
With txtwatch
.SelectionStart = Len(txtwatch.Text)
.SelectionProtected = False
.SelectionStart = Len(txtwatch.Text) + 1
.SelectionColor = System.Drawing.Color.Red
.SelectedText = "Fichier créé : " & e.Name & " " & Date.Now & vbCrLf
.SelectionProtected = True
.Focus()
.SelectionStart = txtwatch.Text.Length
.ScrollToCaret()
End With
'*******************************************************************
fct_wait_sec(60000)
fct_lire_txt(e)
End If
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & e.Name, 0, ex.ToString, "none")
'# erreur no 4
End Try
End Sub
Private Sub fct_lire_txt(ByVal e As System.IO.FileSystemEventArgs)
Try
Dim FreeF As Integer
Dim str() As String
Dim val() As String
Dim tmp() As String
FreeF = FreeFile() 'Possibilité de mettre 1************
FileOpen(FreeF, e.FullPath, OpenMode.Input) 'Ouverture du fichier créé**********
str = Split(InputString(FreeF, FileLen(e.FullPath)), Chr(10)) 'Séparation des lignes du fichier***
FileClose(FreeF) 'Fermeture du fichier***************
File.Delete(archive & e.Name)
File.Move(f_in & e.Name, archive & e.Name)
tmp = Split(Replace(Replace(str(0), Chr(34), ""), "'", " "), ";")
If tmp(2).ToUpper <> "V" Then
Exit Sub
End If
fct_fill_sql(str, e.Name.Substring(0, 2).ToUpper)
fct_fill_excel(str, e.Name.Substring(0, 2).ToUpper)
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & e.Name, 0, ex.ToString, "none")
'# erreur no 5
fct_exec_sql("UPDATE pur_order SET err=5 WHERE pur_order.po_number='" & e.Name.Substring(3, 8) & "'")
End Try
End Sub
Private Sub fct_send_mail(ByVal m_from As String, ByVal m_to As String, ByVal m_subject As String, ByVal m_type As Integer, ByVal m_msg As String, ByVal f_name As String)
Try
'Variable pour la création du courriel
Dim smtp_svr As SmtpMail
Dim msg As New MailMessage
Dim fileAttach As MailAttachment
'Ne pas envoyer de message si no de PO non Défini ou si (line 676) le po ne contient pas de lignes, c'est simplement un po annuler mais qui sort quand meme de fdm
If InStr(m_subject, "none") = 0 And InStr(m_msg, "line 676") = 0 Then
'Définition du serveur smtp
smtp_svr.SmtpServer = smtp
'Définition du core du courriel
msg.From = m_from.Trim 'Envoyeur*****************************************
msg.BodyFormat = MailFormat.Html 'Format (txt ou html)*****************************
msg.To = m_to 'Destinataire*************************************
msg.Subject = m_subject 'Sujet********************************************
msg.Body = m_msg 'Message******************************************
msg.Priority = MailPriority.Normal 'priorité NORMAL, HIGH, LOW***********************
If m_type = 1 Then 'Pièce jointe seulement si c'est un envoi de po***
fileAttach = New MailAttachment(f_out & f_name & ".xls") 'Création d'une piece jointe**********************
msg.Attachments.Add(fileAttach) 'Ajout de la pièce jointe*************************
End If
'Envoi du courriel au destinataire
smtp_svr.Send(msg)
End If
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & f_name, 0, ex.ToString, "none")
'# erreur no 6
fct_exec_sql("UPDATE pur_order SET err=6 WHERE pur_order.po_number='" & f_name.Substring(3, 8) & "'")
End Try
End Sub
Private Sub fct_fill_sql(ByVal lines() As String, ByVal sqltype As String)
Dim line_0() As String
Try
Dim line_1() As String
Dim line_2() As String
Dim line_3() As String
Dim line_x() As String
Dim strsql As String
Dim qty As Decimal
If sqltype = "PO" Or sqltype = "MA" Then
'************À supprimer pour service*******************************
With txtwatch
.SelectionStart = Len(txtwatch.Text)
.SelectionProtected = False
.SelectionStart = Len(txtwatch.Text) + 1
.SelectionColor = System.Drawing.Color.Yellow
.SelectedText = lines(0) & vbCrLf
.SelectionProtected = True
.Focus()
.SelectionStart = txtwatch.Text.Length
.ScrollToCaret()
End With
With txtwatch
.SelectionStart = Len(txtwatch.Text)
.SelectionProtected = False
.SelectionStart = Len(txtwatch.Text) + 1
.SelectionColor = System.Drawing.Color.Yellow
.SelectedText = lines(1) & vbCrLf
.SelectionProtected = True
.Focus()
.SelectionStart = txtwatch.Text.Length
.ScrollToCaret()
End With
With txtwatch
.SelectionStart = Len(txtwatch.Text)
.SelectionProtected = False
.SelectionStart = Len(txtwatch.Text) + 1
.SelectionColor = System.Drawing.Color.Yellow
.SelectedText = lines(2) & vbCrLf
.SelectionProtected = True
.Focus()
.SelectionStart = txtwatch.Text.Length
.ScrollToCaret()
End With
With txtwatch
.SelectionStart = Len(txtwatch.Text)
.SelectionProtected = False
.SelectionStart = Len(txtwatch.Text) + 1
.SelectionColor = System.Drawing.Color.Yellow
.SelectedText = lines(3) & vbCrLf
.SelectionProtected = True
.Focus()
.SelectionStart = txtwatch.Text.Length
.ScrollToCaret()
End With
'lbWatch.Items.Add(lines(0))
'lbWatch.Items.Add(lines(1))
'lbWatch.Items.Add(lines(2))
'lbWatch.Items.Add(lines(3))
'*******************************************************************
'lines(0)
line_0 = Split(Replace(Replace(lines(0), Chr(34), ""), "'", " "), ";")
'lines(1)
line_1 = Split(Replace(Replace(lines(1), Chr(34), ""), "'", " "), ";")
'lines(2)
line_2 = Split(Replace(Replace(lines(2), Chr(34), ""), "'", " "), ";")
'lines(3)
line_3 = Split(Replace(Replace(lines(3), Chr(34), ""), "'", " "), ";")
'Étant donné que le po est repassé au complet, delete de toutes categ dans po_categ, recommencé à zéro le calcul des categs
strsql = "DELETE FROM po_categ WHERE po_number='" & line_0(1) & "'"
fct_exec_sql(strsql)
'Étant donné que le po est repassé au complet, delete de toutes ligne dans po_line, recommencé à zéro le calcul des items
strsql = "DELETE FROM po_line WHERE po_number='" & line_0(1) & "'"
fct_exec_sql(strsql)
'Étant donné que le po est repassé au complet, delete du po
strsql = "DELETE FROM pur_order WHERE po_number='" & line_0(1) & "'"
fct_exec_sql(strsql)
'Création des lignes de PO
For i As Integer = 4 To lines.GetUpperBound(0) - 1
'************À supprimer pour service*******************************
'lbWatch.Items.Add(lines(i))
With txtwatch
.SelectionStart = Len(txtwatch.Text)
.SelectionProtected = False
.SelectionStart = Len(txtwatch.Text) + 1
.SelectionColor = System.Drawing.Color.Yellow
.SelectedText = lines(i) & vbCrLf
.SelectionProtected = True
.Focus()
.SelectionStart = txtwatch.Text.Length
.ScrollToCaret()
End With
'*******************************************************************
line_x = Split(Replace(Replace(lines(i), Chr(34), ""), "'", " "), ";")
qty = qty + line_x(1) - line_x(9)
'ligne de po
strsql = "INSERT INTO po_line (po_number,po_line,qty,vendor_item,description,item_number,uom,price,amount,item_categ,rec_qty)" & _
" VALUES('" & line_0(1) & "'," & line_x(0) & ",'" & line_x(1) & "','" & line_x(2) & "','" & line_x(3) & "','" & _
line_x(4) & "','" & line_x(5) & "','" & line_x(6) & "','" & line_x(7) & "','" & line_x(8).ToUpper & "','" & line_x(9) & "')"
fct_exec_sql(strsql)
'categorie de l'item
If fct_check_sql("Select item_categ from po_categ where po_number = '" & line_0(1) & "' AND item_categ='" & line_x(8).ToUpper & "'", "item_categ", line_x(8)) Then
strsql = "UPDATE po_categ SET qty=qty+" & line_x(1) & " WHERE po_number='" & line_0(1) & "' AND item_categ='" & line_x(8).ToUpper & "'"
Else
strsql = "INSERT INTO po_categ (po_number,item_categ,qty) VALUES('" & line_0(1) & "','" & line_x(8).ToUpper & "','" & line_x(1) & "')"
End If
fct_exec_sql(strsql)
Next
'Création de l'entête du PO
'insert un entête de po s'il n'existe pas
strsql = "INSERT INTO pur_order (po_number,langue,vendor,vendor_name,addr1,addr2,city,prov,zip,contact,warehouse,ship_name,ship_addr1," & _
"ship_addr2,ship_city,ship_prov,ship_zip,order_date,rec_date,invoice_num,buyer,terms,freight,ship,fob,tx,amount," & _
"qty,email,currency,closed) VALUES('" & line_0(1) & "', '" & line_1(1) & "', '" & line_2(0) & "', '" & _
line_3(0) & "', '" & line_3(1) & "', '" & line_3(2) & "', '" & line_3(3) & "', '" & line_3(4) & "', '" & line_3(5) & _
"', '" & line_3(6) & "', '" & line_2(21) & "', '" & line_2(14) & "', '" & line_2(6) & "', '" & line_2(7) & "', '" & _
line_2(8) & "', '" & line_2(9) & "', '" & line_2(10) & "', '" & line_2(2) & "', '" & line_2(3) & "', '" & line_2(4) & _
"', '" & line_2(12) & "', '" & line_2(5) & "', '" & line_2(11) & "', '" & line_2(17) & "', '" & line_2(13) & "', '" & _
line_2(19) & "', '" & line_2(16) & "', " & qty & ", '" & line_1(0) & "', '" & line_2(15) & "', 0)"
fct_exec_sql(strsql)
If sqltype = "MA" Then
strsql = "UPDATE pur_order SET sortie='@' WHERE po_number='" & line_0(1) & "'"
fct_exec_sql(strsql)
End If
ElseIf sqltype = "RE" Then
For i As Integer = 0 To lines.GetUpperBound(0) - 1
'************À supprimer pour service*******************************
'lbWatch.Items.Add(lines(i))
With txtwatch
.SelectionStart = Len(txtwatch.Text)
.SelectionProtected = False
.SelectionStart = Len(txtwatch.Text) + 1
.SelectionColor = System.Drawing.Color.Yellow
.SelectedText = lines(i) & vbCrLf
.SelectionProtected = True
.Focus()
.SelectionStart = txtwatch.Text.Length
.ScrollToCaret()
End With
'*******************************************************************
line_x = Split(Replace(Replace(lines(i), Chr(34), ""), "'", " "), ";")
'Update de la ligne de PO
strsql = "UPDATE po_line SET rec_qty='" & line_x(3) & "' WHERE po_number='" & line_x(0) & "' AND po_line=" & line_x(1)
fct_exec_sql(strsql)
If fct_check_sql("Select qty from po_categ where po_number = '" & line_x(0) & "' AND item_categ='" & line_x(5) & "'", "po_categ", 0) = False Then
'Update de la catégorie selon le PO
strsql = "UPDATE po_categ SET qty= qty - " & line_x(3) & " WHERE po_number='" & line_x(0) & "' AND item_categ='" & line_x(5) & "'"
fct_exec_sql(strsql)
End If
If fct_check_sql("Select qty from pur_order where po_number = '" & line_x(0) & "'", "pur_order", 0) = False Then
If line_x(4).ToUpper = "O" Then
strsql = "UPDATE pur_order SET qty = qty - " & line_x(3) & " WHERE po_number='" & line_x(0) & "'"
Else
strsql = "UPDATE pur_order SET qty = qty - " & line_x(3) & ", closed=1 WHERE po_number='" & line_x(0) & "'"
End If
fct_exec_sql(strsql)
End If
Next
End If
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & line_0(1), 0, ex.ToString, "none")
'# erreur no 7
fct_exec_sql("UPDATE pur_order SET err=7 WHERE pur_order.po_number='" & line_0(1) & "'")
End Try
End Sub
Private Sub fct_fill_excel(ByVal lines() As String, ByVal sqltype As String)
Dim line_0() As String
Try
Dim line_1() As String
Dim line_2() As String
Dim line_3() As String
Dim line_x() As String
Dim i As Integer
Dim strsql As String
Dim qty As Decimal
Dim S1, ErrStr As String
Dim po_xl As New Excel.Application
Dim po_book As Excel.Workbook
Dim po_sheet As Excel.Worksheet
If sqltype = "PO" Or sqltype = "MA" Then
'lines(0)
line_0 = Split(Replace(Replace(lines(0), Chr(34), ""), "'", " "), ";")
'lines(1)
line_1 = Split(Replace(Replace(lines(1), Chr(34), ""), "'", " "), ";")
'lines(2)
line_2 = Split(Replace(Replace(lines(2), Chr(34), ""), "'", " "), ";")
'lines(3)
line_3 = Split(Replace(Replace(lines(3), Chr(34), ""), "'", " "), ";")
'Création des settings pour la gestion du po dans excel
po_xl = New Excel.Application
If line_1(1) = "E" Then
po_book = po_xl.Workbooks.Open(Filename:=layout_e)
'po_xl.Workbooks.Open(Filename:=layout_e)
Else
po_book = po_xl.Workbooks.Open(Filename:=layout_f)
'po_xl.Workbooks.Open(Filename:=layout_f)
End If
po_sheet = po_book.ActiveSheet
po_xl.Visible = False
'Création de l'entête du PO
'to
If line_3(1) <> "" And line_3(2) <> "" Then
po_sheet.Cells(2, 7) = line_2(0).ToUpper
po_sheet.Cells(3, 7) = line_3(0).ToUpper
po_sheet.Cells(4, 7) = line_3(1).ToUpper
po_sheet.Cells(5, 7) = line_3(2).ToUpper
po_sheet.Cells(6, 7) = line_3(3).ToUpper & ", " & line_3(4).ToUpper & " " & line_3(5).ToUpper
po_sheet.Cells(7, 7) = line_3(6).ToUpper
ElseIf line_3(1) = "" And line_3(2) = "" Then
po_sheet.Cells(2, 7) = line_2(0).ToUpper
po_sheet.Cells(3, 7) = line_3(0).ToUpper
po_sheet.Cells(4, 7) = line_3(3).ToUpper & ", " & line_3(4).ToUpper & " " & line_3(5).ToUpper
po_sheet.Cells(7, 7) = line_3(6).ToUpper
ElseIf line_3(1) <> "" And line_3(2) = "" Then
po_sheet.Cells(2, 7) = line_2(0).ToUpper
po_sheet.Cells(3, 7) = line_3(0).ToUpper
po_sheet.Cells(4, 7) = line_3(1).ToUpper
po_sheet.Cells(5, 7) = line_3(3).ToUpper & ", " & line_3(4).ToUpper & " " & line_3(5).ToUpper
po_sheet.Cells(7, 7) = line_3(6).ToUpper
ElseIf line_3(1) = "" And line_3(2) <> "" Then
po_sheet.Cells(2, 7) = line_2(0).ToUpper
po_sheet.Cells(3, 7) = line_3(0).ToUpper
po_sheet.Cells(4, 7) = line_3(2).ToUpper
po_sheet.Cells(5, 7) = line_3(3).ToUpper & ", " & line_3(4).ToUpper & " " & line_3(5).ToUpper
po_sheet.Cells(7, 7) = line_3(6).ToUpper
End If
'ship to
If line_2(6) <> "" And line_2(7) <> "" Then
po_sheet.Cells(2, 15) = line_2(21).ToUpper
po_sheet.Cells(3, 15) = line_2(14).ToUpper
po_sheet.Cells(4, 15) = line_2(6).ToUpper
po_sheet.Cells(5, 15) = line_2(7).ToUpper
po_sheet.Cells(6, 15) = line_2(8).ToUpper & ", " & line_2(9).ToUpper & " " & line_2(10).ToUpper
po_sheet.Cells(7, 15) = line_2(12).ToUpper
ElseIf line_2(6) = "" And line_2(7) = "" Then
po_sheet.Cells(2, 15) = line_2(21).ToUpper
po_sheet.Cells(3, 15) = line_2(14).ToUpper
po_sheet.Cells(4, 15) = line_2(8).ToUpper & ", " & line_2(9).ToUpper & " " & line_2(10).ToUpper
po_sheet.Cells(7, 15) = line_2(12).ToUpper
ElseIf line_2(6) <> "" And line_2(7) = "" Then
po_sheet.Cells(2, 15) = line_2(21).ToUpper
po_sheet.Cells(3, 15) = line_2(14).ToUpper
po_sheet.Cells(4, 15) = line_2(6).ToUpper
po_sheet.Cells(5, 15) = line_2(8).ToUpper & ", " & line_2(9).ToUpper & " " & line_2(10).ToUpper
po_sheet.Cells(7, 15) = line_2(12).ToUpper
ElseIf line_2(6) = "" And line_2(7) <> "" Then
po_sheet.Cells(2, 15) = line_2(21).ToUpper
po_sheet.Cells(3, 15) = line_2(14).ToUpper
po_sheet.Cells(4, 15) = line_2(7).ToUpper
po_sheet.Cells(5, 15) = line_2(8).ToUpper & ", " & line_2(9).ToUpper & " " & line_2(10).ToUpper
po_sheet.Cells(7, 15) = line_2(12).ToUpper
End If
'# cmd
po_sheet.Cells(10, 1) = line_2(1).ToUpper
'Date cmd
If line_1(1) = "E" Then
po_sheet.Cells(10, 5) = line_2(2).Substring(3, 2) & "/" & line_2(2).Substring(6, 2) & "/" & line_2(2).Substring(0, 2)
Else
po_sheet.Cells(10, 5) = line_2(2).Substring(6, 2) & "/" & line_2(2).Substring(3, 2) & "/" & line_2(2).Substring(0, 2)
End If
'Date livrais
If line_1(1) = "E" Then
po_sheet.Cells(10, 6) = line_2(3).Substring(3, 2) & "/" & line_2(3).Substring(6, 2) & "/" & line_2(3).Substring(0, 2)
Else
po_sheet.Cells(10, 6) = line_2(3).Substring(6, 2) & "/" & line_2(3).Substring(3, 2) & "/" & line_2(3).Substring(0, 2)
End If
'Ship by
po_sheet.Cells(10, 7) = line_2(17).ToUpper
'FOB
po_sheet.Cells(10, 10) = line_2(13).ToUpper
'tx
po_sheet.Cells(9, 16) = line_2(19).ToUpper
po_sheet.Cells(10, 16) = line_2(20).ToUpper
'# fact
po_sheet.Cells(12, 1) = line_2(4).ToUpper
'Buyer
po_sheet.Cells(12, 5) = line_2(12).ToUpper
'Terms
po_sheet.Cells(12, 8) = line_2(5).ToUpper
'Freight
po_sheet.Cells(12, 11) = line_2(11).ToUpper
'Création des lignes de PO
For i = 4 To lines.GetUpperBound(0) - 1
line_x = Split(Replace(Replace(lines(i), Chr(34), ""), "'", " "), ";")
qty = qty + line_x(1)
'line
po_sheet.Cells(12 + i, 1) = line_x(0).ToUpper
'qte
po_sheet.Cells(12 + i, 2) = line_x(1).ToUpper
'vendor-item
If line_x(2) = "" Then
po_sheet.Cells(12 + i, 4) = line_x(4).ToUpper
Else
po_sheet.Cells(12 + i, 4) = line_x(2).ToUpper
End If
'desc
po_sheet.Cells(12 + i, 6) = line_x(3).ToUpper
'item-number
po_sheet.Cells(12 + i, 11) = "#PHV : " & line_x(4).ToUpper
'udm
po_sheet.Cells(12 + i, 15) = line_x(5).ToUpper
'prix
po_sheet.Cells(12 + i, 16) = CDec(line_x(6))
'amount
po_sheet.Cells(12 + i, 17) = CDec(line_x(7))
Next
po_sheet.Cells(12 + i + 1, 4) = line_x(10).ToUpper & line_x(11).ToUpper & line_x(12).ToUpper & line_x(13).ToUpper & line_x(14).ToUpper & line_x(15).ToUpper & line_x(16).ToUpper & line_x(17).ToUpper & line_x(18).ToUpper & line_x(19).ToUpper & line_x(20).ToUpper & line_x(21).ToUpper & line_x(22).ToUpper & line_x(23).ToUpper
po_sheet.Cells(12 + i + 3, 2) = "________"
po_sheet.Cells(12 + i + 3, 17) = "___________"
If line_1(1) = "E" Then
If line_2(15) = "USD" Then
po_sheet.Cells(12 + i + 3, 5) = "****** AMOUNTS SPECIFIED IN U.S.A CURRENCY ******"
Else
po_sheet.Cells(12 + i + 3, 5) = "******* AMOUNTS SPECIFIED IN CDN CURRENCY *******"
End If
Else
If line_2(15) = "USD" Then
po_sheet.Cells(12 + i + 3, 5) = "****** MONTANTS SPÉCIFIÉS EN DEVISE CDN ******"
Else
po_sheet.Cells(12 + i + 3, 5) = "****** MONTANTS SPÉCIFIÉS EN DEVISE USA ******"
End If
End If
po_sheet.Cells(12 + i + 4, 2) = qty
po_sheet.Cells(12 + i + 4, 16) = "TOTAL : "
po_sheet.Cells(12 + i + 4, 17) = CDec(line_2(16))
If File.Exists(f_out & "po_" & line_0(1) & ".xls") Then
File.Delete(f_out & "po_" & line_0(1) & ".xls")
End If
If line_0(0) = "@" Then
po_sheet.SaveAs(f_out & "ma_" & line_0(1) & ".xls")
Else
po_sheet.SaveAs(f_out & "po_" & line_0(1) & ".xls")
End If
po_xl.Quit()
po_sheet = Nothing
po_book = Nothing
po_xl = Nothing
'Kill du process excel
Dim Processes As Process() = Nothing
Processes = Process.GetProcessesByName("EXCEL")
' Load ID Processes in Array
Dim intProcesses(Processes.GetUpperBound(0)) As Int16
Dim j As Int16
For j = 0 To Processes.GetUpperBound(0)
Process.GetProcessById(CInt(Processes(j).Id.ToString)).Kill()
Next
'Envoi du email si tel est le cas
If line_0(0) = "@" Then
fct_wait_sec(60000)
fct_send_mail(envoyeur, line_1(0), "Purchase Order/Commande d'Achat # " & line_0(1), 1, "<font face=arial size=2 color='black'>Purchase Order/Commande d'Achat # " & line_0(1) & "</font><br><br><img src='" & signature & "'><br><br><b><font face=arial size=2 color='#aaaaaa'>DISCLAIMER: </b><BR>This communication is for use by the intended recipient and contains information that may be privileged, confidential or copyrighted under applicable law. If you are not the intended recipient, you are hereby formally notified that any use, copying or distribution of this e-mail, in whole or in part, is strictly prohibited. Please notify the sender by return e-mail from your system.</font>", "ma_" & line_0(1))
End If
End If
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & line_0(1), 0, ex.ToString, "none")
'# erreur no 8
fct_exec_sql("UPDATE pur_order SET err=8 WHERE pur_order.po_number='" & line_0(1) & "'")
End Try
End Sub
Private Sub fct_exec_sql(ByVal strSql As String)
Try
Dim cnx As String 'Chaine de connexion sql*********************
Dim sqlcnx As SqlClient.SqlConnection 'déclaration de sqlCnx comme connexion SQL***
Dim sqlcmd As SqlClient.SqlCommand 'déclaration de sqlcmd comme commande SQL****
'connexion
cnx = "workstation id=" & server & ";packet size=4096;integrated security=SSPI;data source=" & server & ";persist security info=False;initial catalog=" & bd
sqlcnx = New SqlClient.SqlConnection
sqlcnx.ConnectionString = cnx
sqlcnx.Open()
'commande
sqlcmd = New SqlClient.SqlCommand
sqlcmd.Connection = sqlcnx
'executer la requête
sqlcmd.CommandText = strSql
sqlcmd.Prepare()
sqlcmd.ExecuteNonQuery()
sqlcnx.Close()
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL ERR SQL", 0, ex.ToString & vbCrLf & strSql, "none")
'# erreur no 9
End Try
End Sub
Private Function fct_check_sql(ByVal strSql As String, ByVal strtb As String, ByVal po_number As String) As Boolean
Try
Dim cnx As String 'Chaine de connexion sql****************************
Dim sqlcnx As SqlClient.SqlConnection 'déclaration de sqlCnx comme connexion SQL**********
Dim sqlcmd As SqlClient.SqlCommand 'déclaration de sqlcmd comme commande SQL***********
Dim sqlda As SqlClient.SqlDataAdapter 'déclaration de sqlad comme data adapter************
Dim sqlds As DataSet 'déclaration de sqlds comme dataset*****************
Dim sqldt As DataTable 'déclaration de sqlds comme table sql***************
Dim ck As Boolean 'déclaration de ck comme variable de vérification***
'connexion
cnx = "Server=" & server & ";Database=" & bd & ";User ID=" & usr & ";Password=" & pwd & ";Trusted_Connection=False;"
sqlcnx = New SqlClient.SqlConnection
sqlcnx.ConnectionString = cnx
sqlcnx.Open()
'commande
sqlcmd = New SqlClient.SqlCommand(strSql)
sqlcmd.Connection = sqlcnx
'traitement dataset
sqlda = New SqlClient.SqlDataAdapter(sqlcmd)
sqlds = New DataSet
sqlda.Fill(sqlds, strtb)
If sqlds.Tables(strtb).Rows.Count > 0 Then
If po_number = sqlds.Tables(strtb).Rows(0)(0).ToString().Trim() Then
ck = True
Else
ck = False
End If
Else
ck = False
End If
'Fermeture
sqlcnx.Close()
Return ck
Catch ex As Exception
fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL SQL", 0, ex.ToString & vbCrLf & strSql, "none")
'# erreur no 10
End Try
End Function
Private Sub frmPrinc_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
Dim app As Application
fct_send_mail("purchase@ph.ca", warning, "ERREUR PO FERME", 0, "Aille les gars je me suis fermé rouvrer moi " & vbCrLf & app.StartupPath & "\PoMailPh.exe", "none")
End Sub
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
Dim strsql As String
strsql = "UPDATE working SET lastcall='" & Date.Now & "' WHERE id=0"
fct_exec_sql(strsql)
End Sub
Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
stHeure.Text = Date.Now.TimeOfDay.ToString.Substring(0, 8)
If Date.Now.TimeOfDay.ToString.Substring(0, 8) >= "23:00:00" And Date.Now.TimeOfDay.ToString.Substring(0, 8) <= "23:05:00" Then
Me.Close()
End If
End Sub
Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click
Dim config As New frmConfig
config.Show()
End Sub
Private Sub frmPrinc_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Activated
lbConsole.Items.Clear()
'************À supprimer pour service*******************************
lbConsole.Items.Add("Sender : " & envoyeur)
lbConsole.Items.Add("Warning : " & warning)
lbConsole.Items.Add("Folder in : " & f_in)
lbConsole.Items.Add("Folder out : " & f_out)
lbConsole.Items.Add("Layout en : " & layout_e)
lbConsole.Items.Add("Layout fr : " & layout_f)
lbConsole.Items.Add("Smtp : " & smtp)
lbConsole.Items.Add("Serveur BD : " & server)
lbConsole.Items.Add("Database : " & bd)
lbConsole.Items.Add("User BD : " & usr)
lbConsole.Items.Add("Pwd BD : " & pwd)
'*******************************************************************
End Sub
Private Sub MenuItem4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem4.Click
Me.Close()
End Sub
End Class
Merci beaucoup pour vos reponses,
je vous poste tout mon code en esperant trouver une solution.
Imports System.IO Imports System.Diagnostics Imports System.Web.mail Public Class frmPrinc Inherits System.Windows.Forms.Form 'variable initial fichier config.ini Private email As String Private watchfolder As FileSystemWatcher #Region " Code généré par le Concepteur Windows Form " Public Sub New() MyBase.New() 'Cet appel est requis par le Concepteur Windows Form. InitializeComponent() 'Ajoutez une initialisation quelconque après l'appel InitializeComponent() End Sub 'La méthode substituée Dispose du formulaire pour nettoyer la liste des composants. Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean) If disposing Then If Not (components Is Nothing) Then components.Dispose() End If End If MyBase.Dispose(disposing) End Sub 'Requis par le Concepteur Windows Form Private components As System.ComponentModel.IContainer 'REMARQUE : la procédure suivante est requise par le Concepteur Windows Form 'Elle peut être modifiée en utilisant le Concepteur Windows Form. 'Ne la modifiez pas en utilisant l'éditeur de code. Friend WithEvents lbConsole As System.Windows.Forms.ListBox Friend WithEvents txtwatch As System.Windows.Forms.RichTextBox Friend WithEvents Timer1 As System.Windows.Forms.Timer Friend WithEvents Timer2 As System.Windows.Forms.Timer Friend WithEvents st As System.Windows.Forms.StatusBar Friend WithEvents stPending As System.Windows.Forms.StatusBarPanel Friend WithEvents stHeure As System.Windows.Forms.StatusBarPanel Friend WithEvents MainMenu1 As System.Windows.Forms.MainMenu Friend WithEvents MenuItem1 As System.Windows.Forms.MenuItem Friend WithEvents MenuItem2 As System.Windows.Forms.MenuItem Friend WithEvents MenuItem3 As System.Windows.Forms.MenuItem Friend WithEvents MenuItem4 As System.Windows.Forms.MenuItem <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent() Me.components = New System.ComponentModel.Container Me.lbConsole = New System.Windows.Forms.ListBox Me.txtwatch = New System.Windows.Forms.RichTextBox Me.Timer1 = New System.Windows.Forms.Timer(Me.components) Me.Timer2 = New System.Windows.Forms.Timer(Me.components) Me.st = New System.Windows.Forms.StatusBar Me.stPending = New System.Windows.Forms.StatusBarPanel Me.stHeure = New System.Windows.Forms.StatusBarPanel Me.MainMenu1 = New System.Windows.Forms.MainMenu Me.MenuItem1 = New System.Windows.Forms.MenuItem Me.MenuItem2 = New System.Windows.Forms.MenuItem Me.MenuItem3 = New System.Windows.Forms.MenuItem Me.MenuItem4 = New System.Windows.Forms.MenuItem CType(Me.stPending, System.ComponentModel.ISupportInitialize).BeginInit() CType(Me.stHeure, System.ComponentModel.ISupportInitialize).BeginInit() Me.SuspendLayout() ' 'lbConsole ' Me.lbConsole.BackColor = System.Drawing.Color.Black Me.lbConsole.Font = New System.Drawing.Font("Courier New", 10.0!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte)) Me.lbConsole.ForeColor = System.Drawing.Color.Chartreuse Me.lbConsole.ItemHeight = 16 Me.lbConsole.Location = New System.Drawing.Point(8, 8) Me.lbConsole.Name = "lbConsole" Me.lbConsole.Size = New System.Drawing.Size(648, 180) Me.lbConsole.TabIndex = 0 ' 'txtwatch ' Me.txtwatch.BackColor = System.Drawing.Color.Black Me.txtwatch.Font = New System.Drawing.Font("Lucida Console", 8.25!, System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, CType(0, Byte)) Me.txtwatch.Location = New System.Drawing.Point(8, 192) Me.txtwatch.Name = "txtwatch" Me.txtwatch.Size = New System.Drawing.Size(648, 176) Me.txtwatch.TabIndex = 2 Me.txtwatch.Text = "" ' 'Timer1 ' Me.Timer1.Enabled = True Me.Timer1.Interval = 600000 ' 'Timer2 ' Me.Timer2.Enabled = True Me.Timer2.Interval = 1000 ' 'st ' Me.st.Location = New System.Drawing.Point(0, 376) Me.st.Name = "st" Me.st.Panels.AddRange(New System.Windows.Forms.StatusBarPanel() {Me.stPending, Me.stHeure}) Me.st.ShowPanels = True Me.st.Size = New System.Drawing.Size(664, 22) Me.st.TabIndex = 3 ' 'stPending ' Me.stPending.Alignment = System.Windows.Forms.HorizontalAlignment.Right Me.stPending.Width = 540 ' 'stHeure ' Me.stHeure.Width = 124 ' 'MainMenu1 ' Me.MainMenu1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MenuItem1}) ' 'MenuItem1 ' Me.MenuItem1.Index = 0 Me.MenuItem1.MenuItems.AddRange(New System.Windows.Forms.MenuItem() {Me.MenuItem2, Me.MenuItem3, Me.MenuItem4}) Me.MenuItem1.Text = "Fichier" ' 'MenuItem2 ' Me.MenuItem2.Index = 0 Me.MenuItem2.Text = "Propriétés..." ' 'MenuItem3 ' Me.MenuItem3.Index = 1 Me.MenuItem3.Text = "-" ' 'MenuItem4 ' Me.MenuItem4.Index = 2 Me.MenuItem4.Text = "Quitter" ' 'frmPrinc ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13) Me.ClientSize = New System.Drawing.Size(664, 398) Me.Controls.Add(Me.st) Me.Controls.Add(Me.txtwatch) Me.Controls.Add(Me.lbConsole) Me.Menu = Me.MainMenu1 Me.Name = "frmPrinc" Me.Text = "Console" CType(Me.stPending, System.ComponentModel.ISupportInitialize).EndInit() CType(Me.stHeure, System.ComponentModel.ISupportInitialize).EndInit() Me.ResumeLayout(False) End Sub #End Region Private Sub frmPrinc_Load(ByVal senderer As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load fct_init_app() fct_watch_folder() fct_send_mail(envoyeur, warning, "ERREUR PO OUVERT ", 0, "C'est beau arrêtez de capoter, je suis rouvert!!!!", "none") End Sub Private Sub fct_init_app() 'initialisation des variables du fichier config.ini Dim i As Integer Dim sFiles() As String Try Dim FreeF As Integer Dim str() As String Dim val() As String Dim app As Application Dim tmp() As String FreeF = FreeFile() 'Possibilité de mettre 1************ FileOpen(FreeF, app.StartupPath & "\config.ini", OpenMode.Input) 'Ouverture du fichier config.ini**** str = Split(InputString(FreeF, FileLen(app.StartupPath & "\config.ini")), Chr(13)) 'Séparation des lignes du fichier*** FileClose(FreeF) 'Fermeture du fichier*************** 'assignation des variables val = Split(str(0), ":") envoyeur = val(1) val = Split(str(1), ":") warning = val(1) val = Split(str(2), ":") f_in = val(1) val = Split(str(3), ":") f_out = val(1) val = Split(str(4), ":") layout_e = val(1) val = Split(str(5), ":") layout_f = val(1) val = Split(str(6), ":") smtp = val(1) val = Split(str(7), ":") signature = val(1) val = Split(str(8), ":") archive = val(1) val = Split(str(9), ":") server = val(1) val = Split(str(10), ":") bd = val(1) val = Split(str(11), ":") usr = val(1) val = Split(str(12), ":") pwd = val(1) '************À supprimer pour service******************************* lbConsole.Items.Add("Sender : " & envoyeur) lbConsole.Items.Add("Warning : " & warning) lbConsole.Items.Add("Folder in : " & f_in) lbConsole.Items.Add("Folder out : " & f_out) lbConsole.Items.Add("Layout en : " & layout_e) lbConsole.Items.Add("Layout fr : " & layout_f) lbConsole.Items.Add("Smtp : " & smtp) lbConsole.Items.Add("Serveur BD : " & server) lbConsole.Items.Add("Database : " & bd) lbConsole.Items.Add("User BD : " & usr) lbConsole.Items.Add("Pwd BD : " & pwd) '******************************************************************* If Not File.Exists(f_in & "\pomail.lock") Then ' pour avoir les noms des fichiers et des sous-répertoires sFiles = Directory.GetFiles(f_in) For i = 0 To sFiles.GetUpperBound(0) If InStr(sFiles(i), ".txt") > 0 Then FreeF = FreeFile() 'Possibilité de mettre 1************ FileOpen(FreeF, sFiles(i), OpenMode.Input) 'Ouverture du fichier créé********** str = Split(InputString(FreeF, FileLen(sFiles(i))), Chr(10)) 'Séparation des lignes du fichier*** FileClose(FreeF) File.Delete(archive & sFiles(i).Substring(27, sFiles(i).Length - 27)) File.Move(sFiles(i), archive & sFiles(i).Substring(27, sFiles(i).Length - 27)) With txtwatch .SelectionStart = Len(txtwatch.Text) .SelectionProtected = False .SelectionStart = Len(txtwatch.Text) + 1 .SelectionColor = System.Drawing.Color.Red .SelectedText = "Fichier créé : " & Replace(sFiles(i), f_in, "") & " " & Date.Now & vbCrLf .SelectionProtected = True .Focus() .SelectionStart = txtwatch.Text.Length .ScrollToCaret() End With tmp = Split(Replace(Replace(str(0), Chr(34), ""), "'", " "), ";") If tmp(2).ToUpper = "V" Then fct_fill_sql(str, sFiles(i).Substring(27, 2).ToUpper) fct_fill_excel(str, sFiles(i).Substring(27, 2).ToUpper) End If End If If File.Exists(f_in & "\pomail.lock") Then Exit For Next End If Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & Replace(sFiles(i), f_in, ""), 0, ex.ToString, "none") '# erreur no 1 fct_exec_sql("UPDATE pur_order SET err=1 WHERE pur_order.po_number='0'") End Try End Sub Private Sub fct_wait_sec(ByVal ms_to_wait As Long) Try Dim endwait As Double endwait = Environment.TickCount + ms_to_wait 'Atttend x milliseconde le temps que UNIX libère le fichier While Environment.TickCount < endwait System.Threading.Thread.Sleep(1) Application.DoEvents() End While Catch ex As Exception '# erreur no 2 fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL", 0, ex.ToString, "none") End Try End Sub Private Sub fct_watch_folder() Try 'Instanciation du watchfolder watchfolder = New System.IO.FileSystemWatcher 'f_in est le répertoire où UNIX dump les infos pour les PO watchfolder.Path = f_in 'Filtre de notification de changement dans le répertoire watchfolder.NotifyFilter = IO.NotifyFilters.DirectoryName watchfolder.NotifyFilter = watchfolder.NotifyFilter Or IO.NotifyFilters.FileName watchfolder.NotifyFilter = watchfolder.NotifyFilter Or IO.NotifyFilters.Attributes 'Ajout d'un évènement sur un fichier créé AddHandler watchfolder.Created, AddressOf fct_in_info 'Propriété a True pour commencé la surveillance watchfolder.EnableRaisingEvents = True Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL", 0, ex.ToString, "none") '# erreur no 3 End Try End Sub Private Sub fct_in_info(ByVal source As Object, ByVal e As System.IO.FileSystemEventArgs) Try 'Vérification création de fichier If e.ChangeType = IO.WatcherChangeTypes.Created Then '************À supprimer pour service******************************* 'lbWatch.Items.Add("Fichier créé : " & e.Name) With txtwatch .SelectionStart = Len(txtwatch.Text) .SelectionProtected = False .SelectionStart = Len(txtwatch.Text) + 1 .SelectionColor = System.Drawing.Color.Red .SelectedText = "Fichier créé : " & e.Name & " " & Date.Now & vbCrLf .SelectionProtected = True .Focus() .SelectionStart = txtwatch.Text.Length .ScrollToCaret() End With '******************************************************************* fct_wait_sec(60000) fct_lire_txt(e) End If Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & e.Name, 0, ex.ToString, "none") '# erreur no 4 End Try End Sub Private Sub fct_lire_txt(ByVal e As System.IO.FileSystemEventArgs) Try Dim FreeF As Integer Dim str() As String Dim val() As String Dim tmp() As String FreeF = FreeFile() 'Possibilité de mettre 1************ FileOpen(FreeF, e.FullPath, OpenMode.Input) 'Ouverture du fichier créé********** str = Split(InputString(FreeF, FileLen(e.FullPath)), Chr(10)) 'Séparation des lignes du fichier*** FileClose(FreeF) 'Fermeture du fichier*************** File.Delete(archive & e.Name) File.Move(f_in & e.Name, archive & e.Name) tmp = Split(Replace(Replace(str(0), Chr(34), ""), "'", " "), ";") If tmp(2).ToUpper <> "V" Then Exit Sub End If fct_fill_sql(str, e.Name.Substring(0, 2).ToUpper) fct_fill_excel(str, e.Name.Substring(0, 2).ToUpper) Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & e.Name, 0, ex.ToString, "none") '# erreur no 5 fct_exec_sql("UPDATE pur_order SET err=5 WHERE pur_order.po_number='" & e.Name.Substring(3, 8) & "'") End Try End Sub Private Sub fct_send_mail(ByVal m_from As String, ByVal m_to As String, ByVal m_subject As String, ByVal m_type As Integer, ByVal m_msg As String, ByVal f_name As String) Try 'Variable pour la création du courriel Dim smtp_svr As SmtpMail Dim msg As New MailMessage Dim fileAttach As MailAttachment 'Ne pas envoyer de message si no de PO non Défini ou si (line 676) le po ne contient pas de lignes, c'est simplement un po annuler mais qui sort quand meme de fdm If InStr(m_subject, "none") = 0 And InStr(m_msg, "line 676") = 0 Then 'Définition du serveur smtp smtp_svr.SmtpServer = smtp 'Définition du core du courriel msg.From = m_from.Trim 'Envoyeur***************************************** msg.BodyFormat = MailFormat.Html 'Format (txt ou html)***************************** msg.To = m_to 'Destinataire************************************* msg.Subject = m_subject 'Sujet******************************************** msg.Body = m_msg 'Message****************************************** msg.Priority = MailPriority.Normal 'priorité NORMAL, HIGH, LOW*********************** If m_type = 1 Then 'Pièce jointe seulement si c'est un envoi de po*** fileAttach = New MailAttachment(f_out & f_name & ".xls") 'Création d'une piece jointe********************** msg.Attachments.Add(fileAttach) 'Ajout de la pièce jointe************************* End If 'Envoi du courriel au destinataire smtp_svr.Send(msg) End If Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & f_name, 0, ex.ToString, "none") '# erreur no 6 fct_exec_sql("UPDATE pur_order SET err=6 WHERE pur_order.po_number='" & f_name.Substring(3, 8) & "'") End Try End Sub Private Sub fct_fill_sql(ByVal lines() As String, ByVal sqltype As String) Dim line_0() As String Try Dim line_1() As String Dim line_2() As String Dim line_3() As String Dim line_x() As String Dim strsql As String Dim qty As Decimal If sqltype = "PO" Or sqltype = "MA" Then '************À supprimer pour service******************************* With txtwatch .SelectionStart = Len(txtwatch.Text) .SelectionProtected = False .SelectionStart = Len(txtwatch.Text) + 1 .SelectionColor = System.Drawing.Color.Yellow .SelectedText = lines(0) & vbCrLf .SelectionProtected = True .Focus() .SelectionStart = txtwatch.Text.Length .ScrollToCaret() End With With txtwatch .SelectionStart = Len(txtwatch.Text) .SelectionProtected = False .SelectionStart = Len(txtwatch.Text) + 1 .SelectionColor = System.Drawing.Color.Yellow .SelectedText = lines(1) & vbCrLf .SelectionProtected = True .Focus() .SelectionStart = txtwatch.Text.Length .ScrollToCaret() End With With txtwatch .SelectionStart = Len(txtwatch.Text) .SelectionProtected = False .SelectionStart = Len(txtwatch.Text) + 1 .SelectionColor = System.Drawing.Color.Yellow .SelectedText = lines(2) & vbCrLf .SelectionProtected = True .Focus() .SelectionStart = txtwatch.Text.Length .ScrollToCaret() End With With txtwatch .SelectionStart = Len(txtwatch.Text) .SelectionProtected = False .SelectionStart = Len(txtwatch.Text) + 1 .SelectionColor = System.Drawing.Color.Yellow .SelectedText = lines(3) & vbCrLf .SelectionProtected = True .Focus() .SelectionStart = txtwatch.Text.Length .ScrollToCaret() End With 'lbWatch.Items.Add(lines(0)) 'lbWatch.Items.Add(lines(1)) 'lbWatch.Items.Add(lines(2)) 'lbWatch.Items.Add(lines(3)) '******************************************************************* 'lines(0) line_0 = Split(Replace(Replace(lines(0), Chr(34), ""), "'", " "), ";") 'lines(1) line_1 = Split(Replace(Replace(lines(1), Chr(34), ""), "'", " "), ";") 'lines(2) line_2 = Split(Replace(Replace(lines(2), Chr(34), ""), "'", " "), ";") 'lines(3) line_3 = Split(Replace(Replace(lines(3), Chr(34), ""), "'", " "), ";") 'Étant donné que le po est repassé au complet, delete de toutes categ dans po_categ, recommencé à zéro le calcul des categs strsql = "DELETE FROM po_categ WHERE po_number='" & line_0(1) & "'" fct_exec_sql(strsql) 'Étant donné que le po est repassé au complet, delete de toutes ligne dans po_line, recommencé à zéro le calcul des items strsql = "DELETE FROM po_line WHERE po_number='" & line_0(1) & "'" fct_exec_sql(strsql) 'Étant donné que le po est repassé au complet, delete du po strsql = "DELETE FROM pur_order WHERE po_number='" & line_0(1) & "'" fct_exec_sql(strsql) 'Création des lignes de PO For i As Integer = 4 To lines.GetUpperBound(0) - 1 '************À supprimer pour service******************************* 'lbWatch.Items.Add(lines(i)) With txtwatch .SelectionStart = Len(txtwatch.Text) .SelectionProtected = False .SelectionStart = Len(txtwatch.Text) + 1 .SelectionColor = System.Drawing.Color.Yellow .SelectedText = lines(i) & vbCrLf .SelectionProtected = True .Focus() .SelectionStart = txtwatch.Text.Length .ScrollToCaret() End With '******************************************************************* line_x = Split(Replace(Replace(lines(i), Chr(34), ""), "'", " "), ";") qty = qty + line_x(1) - line_x(9) 'ligne de po strsql = "INSERT INTO po_line (po_number,po_line,qty,vendor_item,description,item_number,uom,price,amount,item_categ,rec_qty)" & _ " VALUES('" & line_0(1) & "'," & line_x(0) & ",'" & line_x(1) & "','" & line_x(2) & "','" & line_x(3) & "','" & _ line_x(4) & "','" & line_x(5) & "','" & line_x(6) & "','" & line_x(7) & "','" & line_x(8).ToUpper & "','" & line_x(9) & "')" fct_exec_sql(strsql) 'categorie de l'item If fct_check_sql("Select item_categ from po_categ where po_number = '" & line_0(1) & "' AND item_categ='" & line_x(8).ToUpper & "'", "item_categ", line_x(8)) Then strsql = "UPDATE po_categ SET qty=qty+" & line_x(1) & " WHERE po_number='" & line_0(1) & "' AND item_categ='" & line_x(8).ToUpper & "'" Else strsql = "INSERT INTO po_categ (po_number,item_categ,qty) VALUES('" & line_0(1) & "','" & line_x(8).ToUpper & "','" & line_x(1) & "')" End If fct_exec_sql(strsql) Next 'Création de l'entête du PO 'insert un entête de po s'il n'existe pas strsql = "INSERT INTO pur_order (po_number,langue,vendor,vendor_name,addr1,addr2,city,prov,zip,contact,warehouse,ship_name,ship_addr1," & _ "ship_addr2,ship_city,ship_prov,ship_zip,order_date,rec_date,invoice_num,buyer,terms,freight,ship,fob,tx,amount," & _ "qty,email,currency,closed) VALUES('" & line_0(1) & "', '" & line_1(1) & "', '" & line_2(0) & "', '" & _ line_3(0) & "', '" & line_3(1) & "', '" & line_3(2) & "', '" & line_3(3) & "', '" & line_3(4) & "', '" & line_3(5) & _ "', '" & line_3(6) & "', '" & line_2(21) & "', '" & line_2(14) & "', '" & line_2(6) & "', '" & line_2(7) & "', '" & _ line_2(8) & "', '" & line_2(9) & "', '" & line_2(10) & "', '" & line_2(2) & "', '" & line_2(3) & "', '" & line_2(4) & _ "', '" & line_2(12) & "', '" & line_2(5) & "', '" & line_2(11) & "', '" & line_2(17) & "', '" & line_2(13) & "', '" & _ line_2(19) & "', '" & line_2(16) & "', " & qty & ", '" & line_1(0) & "', '" & line_2(15) & "', 0)" fct_exec_sql(strsql) If sqltype = "MA" Then strsql = "UPDATE pur_order SET sortie='@' WHERE po_number='" & line_0(1) & "'" fct_exec_sql(strsql) End If ElseIf sqltype = "RE" Then For i As Integer = 0 To lines.GetUpperBound(0) - 1 '************À supprimer pour service******************************* 'lbWatch.Items.Add(lines(i)) With txtwatch .SelectionStart = Len(txtwatch.Text) .SelectionProtected = False .SelectionStart = Len(txtwatch.Text) + 1 .SelectionColor = System.Drawing.Color.Yellow .SelectedText = lines(i) & vbCrLf .SelectionProtected = True .Focus() .SelectionStart = txtwatch.Text.Length .ScrollToCaret() End With '******************************************************************* line_x = Split(Replace(Replace(lines(i), Chr(34), ""), "'", " "), ";") 'Update de la ligne de PO strsql = "UPDATE po_line SET rec_qty='" & line_x(3) & "' WHERE po_number='" & line_x(0) & "' AND po_line=" & line_x(1) fct_exec_sql(strsql) If fct_check_sql("Select qty from po_categ where po_number = '" & line_x(0) & "' AND item_categ='" & line_x(5) & "'", "po_categ", 0) = False Then 'Update de la catégorie selon le PO strsql = "UPDATE po_categ SET qty= qty - " & line_x(3) & " WHERE po_number='" & line_x(0) & "' AND item_categ='" & line_x(5) & "'" fct_exec_sql(strsql) End If If fct_check_sql("Select qty from pur_order where po_number = '" & line_x(0) & "'", "pur_order", 0) = False Then If line_x(4).ToUpper = "O" Then strsql = "UPDATE pur_order SET qty = qty - " & line_x(3) & " WHERE po_number='" & line_x(0) & "'" Else strsql = "UPDATE pur_order SET qty = qty - " & line_x(3) & ", closed=1 WHERE po_number='" & line_x(0) & "'" End If fct_exec_sql(strsql) End If Next End If Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & line_0(1), 0, ex.ToString, "none") '# erreur no 7 fct_exec_sql("UPDATE pur_order SET err=7 WHERE pur_order.po_number='" & line_0(1) & "'") End Try End Sub Private Sub fct_fill_excel(ByVal lines() As String, ByVal sqltype As String) Dim line_0() As String Try Dim line_1() As String Dim line_2() As String Dim line_3() As String Dim line_x() As String Dim i As Integer Dim strsql As String Dim qty As Decimal Dim S1, ErrStr As String Dim po_xl As New Excel.Application Dim po_book As Excel.Workbook Dim po_sheet As Excel.Worksheet If sqltype = "PO" Or sqltype = "MA" Then 'lines(0) line_0 = Split(Replace(Replace(lines(0), Chr(34), ""), "'", " "), ";") 'lines(1) line_1 = Split(Replace(Replace(lines(1), Chr(34), ""), "'", " "), ";") 'lines(2) line_2 = Split(Replace(Replace(lines(2), Chr(34), ""), "'", " "), ";") 'lines(3) line_3 = Split(Replace(Replace(lines(3), Chr(34), ""), "'", " "), ";") 'Création des settings pour la gestion du po dans excel po_xl = New Excel.Application If line_1(1) = "E" Then po_book = po_xl.Workbooks.Open(Filename:=layout_e) 'po_xl.Workbooks.Open(Filename:=layout_e) Else po_book = po_xl.Workbooks.Open(Filename:=layout_f) 'po_xl.Workbooks.Open(Filename:=layout_f) End If po_sheet = po_book.ActiveSheet po_xl.Visible = False 'Création de l'entête du PO 'to If line_3(1) <> "" And line_3(2) <> "" Then po_sheet.Cells(2, 7) = line_2(0).ToUpper po_sheet.Cells(3, 7) = line_3(0).ToUpper po_sheet.Cells(4, 7) = line_3(1).ToUpper po_sheet.Cells(5, 7) = line_3(2).ToUpper po_sheet.Cells(6, 7) = line_3(3).ToUpper & ", " & line_3(4).ToUpper & " " & line_3(5).ToUpper po_sheet.Cells(7, 7) = line_3(6).ToUpper ElseIf line_3(1) = "" And line_3(2) = "" Then po_sheet.Cells(2, 7) = line_2(0).ToUpper po_sheet.Cells(3, 7) = line_3(0).ToUpper po_sheet.Cells(4, 7) = line_3(3).ToUpper & ", " & line_3(4).ToUpper & " " & line_3(5).ToUpper po_sheet.Cells(7, 7) = line_3(6).ToUpper ElseIf line_3(1) <> "" And line_3(2) = "" Then po_sheet.Cells(2, 7) = line_2(0).ToUpper po_sheet.Cells(3, 7) = line_3(0).ToUpper po_sheet.Cells(4, 7) = line_3(1).ToUpper po_sheet.Cells(5, 7) = line_3(3).ToUpper & ", " & line_3(4).ToUpper & " " & line_3(5).ToUpper po_sheet.Cells(7, 7) = line_3(6).ToUpper ElseIf line_3(1) = "" And line_3(2) <> "" Then po_sheet.Cells(2, 7) = line_2(0).ToUpper po_sheet.Cells(3, 7) = line_3(0).ToUpper po_sheet.Cells(4, 7) = line_3(2).ToUpper po_sheet.Cells(5, 7) = line_3(3).ToUpper & ", " & line_3(4).ToUpper & " " & line_3(5).ToUpper po_sheet.Cells(7, 7) = line_3(6).ToUpper End If 'ship to If line_2(6) <> "" And line_2(7) <> "" Then po_sheet.Cells(2, 15) = line_2(21).ToUpper po_sheet.Cells(3, 15) = line_2(14).ToUpper po_sheet.Cells(4, 15) = line_2(6).ToUpper po_sheet.Cells(5, 15) = line_2(7).ToUpper po_sheet.Cells(6, 15) = line_2(8).ToUpper & ", " & line_2(9).ToUpper & " " & line_2(10).ToUpper po_sheet.Cells(7, 15) = line_2(12).ToUpper ElseIf line_2(6) = "" And line_2(7) = "" Then po_sheet.Cells(2, 15) = line_2(21).ToUpper po_sheet.Cells(3, 15) = line_2(14).ToUpper po_sheet.Cells(4, 15) = line_2(8).ToUpper & ", " & line_2(9).ToUpper & " " & line_2(10).ToUpper po_sheet.Cells(7, 15) = line_2(12).ToUpper ElseIf line_2(6) <> "" And line_2(7) = "" Then po_sheet.Cells(2, 15) = line_2(21).ToUpper po_sheet.Cells(3, 15) = line_2(14).ToUpper po_sheet.Cells(4, 15) = line_2(6).ToUpper po_sheet.Cells(5, 15) = line_2(8).ToUpper & ", " & line_2(9).ToUpper & " " & line_2(10).ToUpper po_sheet.Cells(7, 15) = line_2(12).ToUpper ElseIf line_2(6) = "" And line_2(7) <> "" Then po_sheet.Cells(2, 15) = line_2(21).ToUpper po_sheet.Cells(3, 15) = line_2(14).ToUpper po_sheet.Cells(4, 15) = line_2(7).ToUpper po_sheet.Cells(5, 15) = line_2(8).ToUpper & ", " & line_2(9).ToUpper & " " & line_2(10).ToUpper po_sheet.Cells(7, 15) = line_2(12).ToUpper End If '# cmd po_sheet.Cells(10, 1) = line_2(1).ToUpper 'Date cmd If line_1(1) = "E" Then po_sheet.Cells(10, 5) = line_2(2).Substring(3, 2) & "/" & line_2(2).Substring(6, 2) & "/" & line_2(2).Substring(0, 2) Else po_sheet.Cells(10, 5) = line_2(2).Substring(6, 2) & "/" & line_2(2).Substring(3, 2) & "/" & line_2(2).Substring(0, 2) End If 'Date livrais If line_1(1) = "E" Then po_sheet.Cells(10, 6) = line_2(3).Substring(3, 2) & "/" & line_2(3).Substring(6, 2) & "/" & line_2(3).Substring(0, 2) Else po_sheet.Cells(10, 6) = line_2(3).Substring(6, 2) & "/" & line_2(3).Substring(3, 2) & "/" & line_2(3).Substring(0, 2) End If 'Ship by po_sheet.Cells(10, 7) = line_2(17).ToUpper 'FOB po_sheet.Cells(10, 10) = line_2(13).ToUpper 'tx po_sheet.Cells(9, 16) = line_2(19).ToUpper po_sheet.Cells(10, 16) = line_2(20).ToUpper '# fact po_sheet.Cells(12, 1) = line_2(4).ToUpper 'Buyer po_sheet.Cells(12, 5) = line_2(12).ToUpper 'Terms po_sheet.Cells(12, 8) = line_2(5).ToUpper 'Freight po_sheet.Cells(12, 11) = line_2(11).ToUpper 'Création des lignes de PO For i = 4 To lines.GetUpperBound(0) - 1 line_x = Split(Replace(Replace(lines(i), Chr(34), ""), "'", " "), ";") qty = qty + line_x(1) 'line po_sheet.Cells(12 + i, 1) = line_x(0).ToUpper 'qte po_sheet.Cells(12 + i, 2) = line_x(1).ToUpper 'vendor-item If line_x(2) = "" Then po_sheet.Cells(12 + i, 4) = line_x(4).ToUpper Else po_sheet.Cells(12 + i, 4) = line_x(2).ToUpper End If 'desc po_sheet.Cells(12 + i, 6) = line_x(3).ToUpper 'item-number po_sheet.Cells(12 + i, 11) = "#PHV : " & line_x(4).ToUpper 'udm po_sheet.Cells(12 + i, 15) = line_x(5).ToUpper 'prix po_sheet.Cells(12 + i, 16) = CDec(line_x(6)) 'amount po_sheet.Cells(12 + i, 17) = CDec(line_x(7)) Next po_sheet.Cells(12 + i + 1, 4) = line_x(10).ToUpper & line_x(11).ToUpper & line_x(12).ToUpper & line_x(13).ToUpper & line_x(14).ToUpper & line_x(15).ToUpper & line_x(16).ToUpper & line_x(17).ToUpper & line_x(18).ToUpper & line_x(19).ToUpper & line_x(20).ToUpper & line_x(21).ToUpper & line_x(22).ToUpper & line_x(23).ToUpper po_sheet.Cells(12 + i + 3, 2) = "________" po_sheet.Cells(12 + i + 3, 17) = "___________" If line_1(1) = "E" Then If line_2(15) = "USD" Then po_sheet.Cells(12 + i + 3, 5) = "****** AMOUNTS SPECIFIED IN U.S.A CURRENCY ******" Else po_sheet.Cells(12 + i + 3, 5) = "******* AMOUNTS SPECIFIED IN CDN CURRENCY *******" End If Else If line_2(15) = "USD" Then po_sheet.Cells(12 + i + 3, 5) = "****** MONTANTS SPÉCIFIÉS EN DEVISE CDN ******" Else po_sheet.Cells(12 + i + 3, 5) = "****** MONTANTS SPÉCIFIÉS EN DEVISE USA ******" End If End If po_sheet.Cells(12 + i + 4, 2) = qty po_sheet.Cells(12 + i + 4, 16) = "TOTAL : " po_sheet.Cells(12 + i + 4, 17) = CDec(line_2(16)) If File.Exists(f_out & "po_" & line_0(1) & ".xls") Then File.Delete(f_out & "po_" & line_0(1) & ".xls") End If If line_0(0) = "@" Then po_sheet.SaveAs(f_out & "ma_" & line_0(1) & ".xls") Else po_sheet.SaveAs(f_out & "po_" & line_0(1) & ".xls") End If po_xl.Quit() po_sheet = Nothing po_book = Nothing po_xl = Nothing 'Kill du process excel Dim Processes As Process() = Nothing Processes = Process.GetProcessesByName("EXCEL") ' Load ID Processes in Array Dim intProcesses(Processes.GetUpperBound(0)) As Int16 Dim j As Int16 For j = 0 To Processes.GetUpperBound(0) Process.GetProcessById(CInt(Processes(j).Id.ToString)).Kill() Next 'Envoi du email si tel est le cas If line_0(0) = "@" Then fct_wait_sec(60000) fct_send_mail(envoyeur, line_1(0), "Purchase Order/Commande d'Achat # " & line_0(1), 1, "<font face=arial size=2 color='black'>Purchase Order/Commande d'Achat # " & line_0(1) & "</font><br><br><img src='" & signature & "'><br><br><b><font face=arial size=2 color='#aaaaaa'>DISCLAIMER: </b><BR>This communication is for use by the intended recipient and contains information that may be privileged, confidential or copyrighted under applicable law. If you are not the intended recipient, you are hereby formally notified that any use, copying or distribution of this e-mail, in whole or in part, is strictly prohibited. Please notify the sender by return e-mail from your system.</font>", "ma_" & line_0(1)) End If End If Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL " & line_0(1), 0, ex.ToString, "none") '# erreur no 8 fct_exec_sql("UPDATE pur_order SET err=8 WHERE pur_order.po_number='" & line_0(1) & "'") End Try End Sub Private Sub fct_exec_sql(ByVal strSql As String) Try Dim cnx As String 'Chaine de connexion sql********************* Dim sqlcnx As SqlClient.SqlConnection 'déclaration de sqlCnx comme connexion SQL*** Dim sqlcmd As SqlClient.SqlCommand 'déclaration de sqlcmd comme commande SQL**** 'connexion cnx = "workstation id=" & server & ";packet size=4096;integrated security=SSPI;data source=" & server & ";persist security info=False;initial catalog=" & bd sqlcnx = New SqlClient.SqlConnection sqlcnx.ConnectionString = cnx sqlcnx.Open() 'commande sqlcmd = New SqlClient.SqlCommand sqlcmd.Connection = sqlcnx 'executer la requête sqlcmd.CommandText = strSql sqlcmd.Prepare() sqlcmd.ExecuteNonQuery() sqlcnx.Close() Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL ERR SQL", 0, ex.ToString & vbCrLf & strSql, "none") '# erreur no 9 End Try End Sub Private Function fct_check_sql(ByVal strSql As String, ByVal strtb As String, ByVal po_number As String) As Boolean Try Dim cnx As String 'Chaine de connexion sql**************************** Dim sqlcnx As SqlClient.SqlConnection 'déclaration de sqlCnx comme connexion SQL********** Dim sqlcmd As SqlClient.SqlCommand 'déclaration de sqlcmd comme commande SQL*********** Dim sqlda As SqlClient.SqlDataAdapter 'déclaration de sqlad comme data adapter************ Dim sqlds As DataSet 'déclaration de sqlds comme dataset***************** Dim sqldt As DataTable 'déclaration de sqlds comme table sql*************** Dim ck As Boolean 'déclaration de ck comme variable de vérification*** 'connexion cnx = "Server=" & server & ";Database=" & bd & ";User ID=" & usr & ";Password=" & pwd & ";Trusted_Connection=False;" sqlcnx = New SqlClient.SqlConnection sqlcnx.ConnectionString = cnx sqlcnx.Open() 'commande sqlcmd = New SqlClient.SqlCommand(strSql) sqlcmd.Connection = sqlcnx 'traitement dataset sqlda = New SqlClient.SqlDataAdapter(sqlcmd) sqlds = New DataSet sqlda.Fill(sqlds, strtb) If sqlds.Tables(strtb).Rows.Count > 0 Then If po_number = sqlds.Tables(strtb).Rows(0)(0).ToString().Trim() Then ck = True Else ck = False End If Else ck = False End If 'Fermeture sqlcnx.Close() Return ck Catch ex As Exception fct_send_mail(envoyeur, warning, "ERREUR PO VIA MAIL SQL", 0, ex.ToString & vbCrLf & strSql, "none") '# erreur no 10 End Try End Function Private Sub frmPrinc_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed Dim app As Application fct_send_mail("purchase@ph.ca", warning, "ERREUR PO FERME", 0, "Aille les gars je me suis fermé rouvrer moi " & vbCrLf & app.StartupPath & "\PoMailPh.exe", "none") End Sub Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick Dim strsql As String strsql = "UPDATE working SET lastcall='" & Date.Now & "' WHERE id=0" fct_exec_sql(strsql) End Sub Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick stHeure.Text = Date.Now.TimeOfDay.ToString.Substring(0, 8) If Date.Now.TimeOfDay.ToString.Substring(0, 8) >= "23:00:00" And Date.Now.TimeOfDay.ToString.Substring(0, 8) <= "23:05:00" Then Me.Close() End If End Sub Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click Dim config As New frmConfig config.Show() End Sub Private Sub frmPrinc_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Activated lbConsole.Items.Clear() '************À supprimer pour service******************************* lbConsole.Items.Add("Sender : " & envoyeur) lbConsole.Items.Add("Warning : " & warning) lbConsole.Items.Add("Folder in : " & f_in) lbConsole.Items.Add("Folder out : " & f_out) lbConsole.Items.Add("Layout en : " & layout_e) lbConsole.Items.Add("Layout fr : " & layout_f) lbConsole.Items.Add("Smtp : " & smtp) lbConsole.Items.Add("Serveur BD : " & server) lbConsole.Items.Add("Database : " & bd) lbConsole.Items.Add("User BD : " & usr) lbConsole.Items.Add("Pwd BD : " & pwd) '******************************************************************* End Sub Private Sub MenuItem4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem4.Click Me.Close() End Sub End Class