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.