ustva, cbam, autofakt, etc.

This commit is contained in:
2025-04-17 08:59:42 +02:00
parent 814133b95a
commit 98bd08ca60
18 changed files with 981 additions and 177 deletions

View File

@@ -0,0 +1,306 @@

Imports GrapeCity.DataVisualization.TypeScript
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Outlook
Imports VERAG_PROG_ALLGEMEIN
Public Class cAutomailversand
Sub sendMailSammelrechnung(Sammelrechnungsdatum As Date, SammelrechungArt As Integer, FirmaID As Integer, Optional KundenNr As Integer = -1, Optional mailoeffnen As Boolean = False)
Try
Dim sql As New VERAG_PROG_ALLGEMEIN.SQL
Dim rechnungenMailversand = "SELECT RechnungsNr,RechnungsKundenNr,isnull(tblKundenErweitert.kde_keineMWSt,0) as keineMWST, max(Rechnungsausgang.[RechnungsLandKz]) as RechnungsLandKz, MitgliedslandEU, sum(Rechnungsausgang.SteuerpflichtigerGesamtbetrag) AS Steuer FROM Rechnungsausgang
LEFT JOIN tblKundenErweitert on tblKundenErweitert.kde_KundenNr = Rechnungsausgang.RechnungsKundenNr
INNER JOIN Währungstabelle on LandKz = Rechnungsausgang.RechnungsLandKz
WHERE Rechnungsausgang.Status IN (2) And Rechnungsausgang.Firma_ID = '" & FirmaID & "' And Rechnungsausgang.Sammelrechnung = '" & SammelrechungArt & "' And CONVERT(DATE,Rechnungsausgang.Abfertigungsdatum,104) = '" & Sammelrechnungsdatum.ToShortDateString & "'
and isnull(Rechnungsausgang.Automailversand,0) = 1 and RechnungsNr > 0 " & IIf(KundenNr > 0, " AND RechnungsKundenNr = " & KundenNr, "") & "
GROUP BY RechnungsNr, RechnungsKundenNr,isnull(tblKundenErweitert.kde_keineMWSt,0),RechnungsLandKz, MitgliedslandEU
ORDER BY RechnungsLandKz, RechnungsKundenNr"
Dim dt As DataTable = sql.loadDgvBySql(rechnungenMailversand, "FMZOLL")
Dim MDMKopiedrucken As Boolean = False
For Each row As DataRow In dt.Rows
Dim SR_DT As DataTable = Nothing
Dim RechnungsNr As Integer = -1
Dim DruckDatumZeit As DateTime
Dim Rechnungsdatum = Nothing
Dim ATTACHMENTS As New List(Of cFakt_MailATTach)
'AKTUELL IMMER MIT KOPIE
MDMKopiedrucken = True
Dim isEU As Boolean = row.Item("MitgliedslandEU")
If isEU Then
If row.Item("keineMWST") Then
'1. Schritt: kein MWST Kunde -> ORIGINAL-RE per Mail!
MDMKopiedrucken = Not row.Item("keineMWST")
End If
'2. Schritt: MWST Kunde -> wenn kein MWST-BEtrag ->Original sonst Kopie per Mail!
If MDMKopiedrucken Then
MDMKopiedrucken = CDbl(row.Item("Steuer")) <> 0
End If
Else
'immer KOPIE weil Ausdruck aktuell noch gesendet!
End If
SR_DT = cFakturierung.GET_SR_SQLDT(FirmaID, SammelrechungArt, Sammelrechnungsdatum, row.Item("RechnungsKundenNr"),, , , , True)
Dim AD = New VERAG_PROG_ALLGEMEIN.cAdressen(row.Item("RechnungsKundenNr"))
If RechnungsNr = -1 Then
If SR_DT.Rows.Count > 0 Then
Dim displayView = New DataView(SR_DT, "RechnungsNr is not null", "RechnungsNr", DataViewRowState.CurrentRows)
Dim distinctDT_SR As DataTable = displayView.ToTable(True, "RechnungsNr", "DruckDatumZeit", "Rechnungsdatum")
If distinctDT_SR.Rows.Count = 1 Then
RechnungsNr = distinctDT_SR.Rows(0).Item("RechnungsNr")
DruckDatumZeit = distinctDT_SR.Rows(0).Item("DruckDatumZeit")
Rechnungsdatum = distinctDT_SR.Rows(0).Item("Rechnungsdatum")
End If
End If
End If
Dim SR As Boolean = True
Dim MailTo As String = ""
Dim MailtoCC As String = ""
Dim MailtoBCC As String = ""
If SammelrechungArt <> 6 Then
Dim email_receipt As String = ""
Dim allAtilla = IIf(FirmaID = 7, True, False)
If SR_DT IsNot Nothing AndAlso SR_DT.Rows.Count > 0 Then
For Each r In SR_DT.Rows
If "4801" <> r("FilialenNr") And "4802" <> r("FilialenNr") Then
allAtilla = False
Exit For
End If
Next
End If
email_receipt = IIf(allAtilla, VERAG_PROG_ALLGEMEIN.cKundenKontakte.getMailAdress(AD.AdressenNr, "Rechnung an (ATILLA)"), "")
MailTo = IIf(email_receipt = "", VERAG_PROG_ALLGEMEIN.cKundenKontakte.getMailAdress(AD.AdressenNr, "Rechnung an"), email_receipt) 'VERAG_PROG_ALLGEMEIN.cKundenKontakte.getMailAdress(AD.AdressenNr, "Rechnung an")
MailtoCC = IIf(email_receipt = "", VERAG_PROG_ALLGEMEIN.cKundenKontakte.getMailAdressCC(AD.AdressenNr, "Rechnung an"), VERAG_PROG_ALLGEMEIN.cKundenKontakte.getMailAdressCC(AD.AdressenNr, "Rechnung an (ATILLA)"))
MailtoBCC = IIf(email_receipt = "", VERAG_PROG_ALLGEMEIN.cKundenKontakte.getMailAdressBCC(AD.AdressenNr, "Rechnung an"), VERAG_PROG_ALLGEMEIN.cKundenKontakte.getMailAdressBCC(AD.AdressenNr, "Rechnung an (ATILLA)"))
Else
If AD.E_Mail IsNot Nothing AndAlso AD.E_Mail <> "" Then MailTo &= AD.E_Mail & ";"
If AD.E_Mail2 IsNot Nothing AndAlso AD.E_Mail2 <> "" Then MailTo &= AD.E_Mail2 & ";"
End If
If Not (MailTo = "" AndAlso MailtoCC = "" AndAlso MailtoCC = "") Then
Dim Mailsubject As String
Dim HTMLMail As String
Dim listPDFs As New List(Of String)
setEmailText(row, AD, FirmaID, RechnungsNr, Mailsubject, HTMLMail)
If doRechnung(row.Item("RechnungsKundenNr"), FirmaID, SammelrechungArt, Rechnungsdatum, RechnungsNr, DruckDatumZeit, MDMKopiedrucken, listPDFs) Then
loadAndSetAnhaenge(SR_DT, ATTACHMENTS, listPDFs)
If mailoeffnen Then
Dim Mail = createMail(Mailsubject, HTMLMail, ATTACHMENTS, MailTo, MailtoCC, MailtoBCC)
If setLog(row.Item("RechnungsKundenNr"),,,,,,, Mail) Then
Mail.Display()
End If
Else
If setLog(row.Item("RechnungsKundenNr"), ATTACHMENTS, Mailsubject, HTMLMail, MailTo, MailtoCC, MailtoBCC) Then
End If
End If
End If
End If
Next
Catch ex As System.Exception
VERAG_PROG_ALLGEMEIN.cErrorHandler.ERR(ex.Message, ex.StackTrace, System.Reflection.MethodBase.GetCurrentMethod.Name, VERAG_PROG_ALLGEMEIN.ERROR_OP.MAIL)
End Try
End Sub
Private Sub setEmailText(row As DataRow, AD As cAdressen, Firma_ID As Integer, RechnungsNr As Integer, Subject As String, TextHTML As String)
Dim txtRgNr As String = IIf(RechnungsNr < 0, -1, RechnungsNr)
Dim Mailtext As String
If row.Item("Steuer") = 0 Then
Mailtext &= (New SQL).getValueTxtBySql("SELECT Text FROM Rechnungstexte WHERE Firma_ID=0 AND EMailRechnung=1 AND Rechnungstexte.DrucksteuerungsKz='R' AND LandKZ='" & row.Item("RechnungsLandKz") & "'", "FMZOLL")
End If
Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL
Dim listOfTextconserven As cTextkonserve_LIST = New cTextkonserve_LIST(4, "", Firma_ID)
Dim spracheRechnung As String = "EN" 'Defaultsprache
Select Case AD.LandKz
Case "TR", "RO", "DE", "SRB" : spracheRechnung = AD.LandKz
Case "A", "AT", "D", "CH" : spracheRechnung = "DE"
Case "HR", "SLO", "BIH", "MNE", "MK", "MO" : spracheRechnung = "SRB"
End Select
If listOfTextconserven.LIST.Any(Function(c) c.txt_sprache = spracheRechnung) Then
Dim r As cTextkonserve = listOfTextconserven.LIST.Find(Function(c) c.txt_sprache = spracheRechnung)
If r IsNot Nothing Then
Subject = r.txt_betreff
Subject = Subject.Replace("%BelegNr%", txtRgNr)
TextHTML &= r.txt_text
If Mailtext <> "" Then TextHTML &= Mailtext & vbNewLine
End If
End If
End Sub
Private Function doRechnung(kdNr As Integer, FirmaID As Integer, Sammelrechnungsart As Integer, Rechnungsdatum As Date, lastAktuelle_RgNr As Integer, DruckDatumZeit As Date, Kopie As Boolean, listPDFs As List(Of String), Optional EinzelAnlagen As Boolean = False, Optional Sammelbericht As Boolean = True)
Dim RechnungsNrisSet As Boolean = False
RechnungsNrisSet = cFakturierung.doSAMMELRechnungsDruck(19, 6, Rechnungsdatum, Rechnungsdatum, "", EinzelAnlagen, Sammelbericht, kdNr, 4, listPDFs, "", lastAktuelle_RgNr, DruckDatumZeit, , , ,, ,,, True, Kopie)
Return RechnungsNrisSet
End Function
Private Function createMail(Mailsubject As String, Mailhtml As String, ATTACHMENTS As List(Of cFakt_MailATTach), MailTo As String, MailtoCC As String, MailtoBCC As String) As Microsoft.Office.Interop.Outlook.MailItem
Try
Dim outl As New Outlook.Application
Dim Mail As Microsoft.Office.Interop.Outlook.MailItem
Mail = outl.CreateItem(0)
Mail.Subject = Mailsubject
Mail.Body = Mailhtml
Mail.To = MailTo
Mail.BCC = MailtoBCC
Mail.CC = MailtoCC
For Each a In ATTACHMENTS
Mail.Attachments.Add(a.Pfad, Microsoft.Office.Interop.Outlook.OlAttachmentType.olByValue, , a.MailName)
Next
Return Mail
Catch
End Try
End Function
Private Sub loadAndSetAnhaenge(SR_DT As DataTable, ATTACHMENTS As List(Of cFakt_MailATTach), listPDFs As List(Of String))
ATTACHMENTS.Clear()
'Rechnungsanhänge anfügen
'-----------------------------------------------------------------
If SR_DT IsNot Nothing AndAlso SR_DT.Rows.Count > 0 Then
For Each r In SR_DT.Rows
Dim RG_ANH = VERAG_PROG_ALLGEMEIN.cRechnungsausgang.LOAD_ANHAENGE_LIST(r("RK_ID"))
If RG_ANH IsNot Nothing Then
For Each ANH In RG_ANH
ATTACHMENTS.Add(New cFakt_MailATTach(VERAG_PROG_ALLGEMEIN.cDATENSERVER.GET_PDFPath_BY_DocID(ANH.dsId), ANH.Bezeichnung))
Next
End If
Next
End If
For Each l In listPDFs
ATTACHMENTS.Add(New cFakt_MailATTach(l, ""))
Next
'-----------------------------------------------------------------
End Sub
Private Function setLog(kdNr As Integer, Optional ATTACHMENTS As List(Of cFakt_MailATTach) = Nothing, Optional Mailsubject As String = "", Optional Mailhtml As String = "", Optional MailTo As String = "", Optional MailtoCC As String = "", Optional MailtoBCC As String = "", Optional Mail As Microsoft.Office.Interop.Outlook.MailItem = Nothing) As Boolean
Dim mailcreated As Boolean = False
Dim EMails As String = ""
Dim EMails_CC As String = ""
Dim EMails_BCC As String = ""
Dim EMail_subject As String = ""
Dim EMail_HTML As String = ""
Dim AttCount As Integer = 0
If Mail IsNot Nothing Then
EMails = Mail.To
EMails_CC = Mail.CC
EMails_BCC = Mail.BCC
EMail_subject = Mail.Subject
EMail_HTML = Mail.Body
AttCount = Mail.Attachments.Count
Else
EMails = MailTo
EMails_CC = MailtoCC
EMails_BCC = MailtoBCC
EMail_subject = Mailsubject
EMail_HTML = Mailhtml
AttCount = ATTACHMENTS.Count
End If
Dim API = VERAG_PROG_ALLGEMEIN.cAPI.INSERT_API(VERAG_PROG_ALLGEMEIN.cAPI_INOUT.OUT, VERAG_PROG_ALLGEMEIN.cAPI_Type.MAIL, VERAG_PROG_ALLGEMEIN.cAPI_ART.AVISO_OUT_BELEGMAIL, "SAMMELRECHNUNG",,, kdNr)
API.api_EMail = EMails
API.api_EMailCC = EMails_CC
API.api_EMailBCC = EMails_BCC
API.api_EMailSubject = EMail_subject
API.api_EMailText = EMail_HTML
API.api_EMailAttCnt = AttCount
'API.api_EMailSubject = API.api_EMailSubject.Replace(vbNewLine, "").Replace(vbCr, "").Replace(vbLf, "").Replace(vbCrLf, "").Replace(System.Environment.NewLine, " ")
If Mail IsNot Nothing Then
API.UPDTAE_OK()
mailcreated = True
Else
If VERAG_PROG_ALLGEMEIN.cProgramFunctions.sendMail(EMails, EMail_subject, EMail_HTML, "noreply@verag.ag", False, False, EMails_CC, EMails_BCC, ATTACHMENTS) Then
API.UPDTAE_OK()
mailcreated = True
Else
API.UPDTAE_ERR()
Return mailcreated
End If
End If
Return mailcreated
End Function
End Class