Imports System.IO Public Class usrCntlAuswertungenEV_Veranlagungen Dim SQL As New VERAG_PROG_ALLGEMEIN.SQL Private Property rst As Object Private Sub usrCntlBrgBuchungenFremd_Load(sender As Object, e As EventArgs) Handles Me.Load kdKunde.initKdBox(Me.FindForm) 'datVon.Value = CDate("01." & Now.AddMonths(-1).Month & "." & Now.AddMonths(-1).Year) 'datBis.Value = datVon.Value.AddMonths(1).AddDays(-1) txtJahr.Value = Now.Year cboMonat.SelectedIndex = Now.AddMonths(-1).Month 'datVon_NCTSTR.Value = Now 'datBis_NCTSTR.Value = Now.AddDays(3) lblErr.Visible = False lblCnt.Text = "" lblCnt2.Text = "" End Sub Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click Try Me.Cursor = Cursors.WaitCursor lblCnt.Text = "" lblCnt2.Text = "" Dim dt As DataTable = SQL.loadDgvBySql("SELECT [kde_KundenNr], [Name 1] Name FROM [tblKundenErweitert] INNER JOIN ADRESSEN on adressennr = kde_KundenNr WHERE " & If(kdKunde.KdNr_value > 0, " kde_KundenNr='" & kdKunde.KdNr_value & "' AND ", "") & " [Veranlagungskunde]=1 and Auswahl='A' ", "FMZOLL") If dt Is Nothing Then lblErr.Visible = True : Exit Sub Dim folderpath = "" Dim FolderBrowserDialog1 As New FolderBrowserDialog If FolderBrowserDialog1.ShowDialog() = DialogResult.OK Then folderpath = FolderBrowserDialog1.SelectedPath If vbYes = MsgBox("Es werden '" & dt.Rows.Count & "' Kunden ausgewertet. Möchten Sie fortfahren?", vbYesNoCancel) Then Dim cnt = 1 For Each r In dt.Rows lblCnt.Text = cnt & "/ " & dt.Rows.Count Me.Refresh() Dim EZOLL_SQLSRV = "EZOLL" If cboEzollSRV.Text = "UNISPED" Then EZOLL_SQLSRV = "EZOLL_UNISPED" End If genExcelKd(r("kde_KundenNr"), EZOLL_SQLSRV, folderpath, r("Name")) cnt += 1 Next End If End If Catch ex As Exception MsgBox(ex.Message & ex.StackTrace) End Try Me.Cursor = Cursors.Default End Sub Sub genExcelKd(KdNr, sPath, EZOLL_SQLSRV, Optional EmpfName = "") Dim dt As DataTable = SQL.loadDgvBySql("SELECT [FilialenNr],[AbfertigungsNr],[UnterNr],Empfänger FROM [Speditionsbuch] where (EmpfängerKundenNr='" & KdNr & "' OR VermittlerKundenNr='" & KdNr & "') and cast(Abfertigungsdatum as date) between '" & datAuswertVon.Value & "' and '" & datAuswertBis.Value & "' and Abfertigungsart=38 ORDER BY Abfertigungsdatum ", "FMZOLL") lblCnt2.Text = "" 'EXCEL Try 'Dim sPath As String = Environment.GetFolderPath(Environment.SpecialFolder.Personal) & "\VERAG\SR\" ' My.Computer.FileSystem.GetTempFileName 'If Not My.Computer.FileSystem.DirectoryExists(sPath) Then ' My.Computer.FileSystem.CreateDirectory(sPath) 'End If Dim Path = "" Dim exclApp As Object 'as Application Dim Datei As Object 'as WorkBook Dim Blatt As Object 'Microsoft.Office.Interop.Excel.Worksheet 'As Object 'as Worksheet exclApp = CreateObject("Excel.Application") Dim nodata = False If dt Is Nothing Or dt.Rows.Count = 0 Then nodata = True Try Path = sPath & "\" & If(nodata, "nodata_", "") & "FA_Graz_" & AdjustPath(EmpfName) & ".xlsx" While System.IO.File.Exists(Path) Path = sPath & "\" & If(nodata, "nodata_", "") & "FA_Graz_" & AdjustPath(EmpfName) & "_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx" End While My.Computer.FileSystem.WriteAllBytes(Path, My.Resources.FA_Graz_EV_Veranlagung_Muster, False) 'Path = sPath & If(nodata, "nodata_", "") & "FA_Graz_" & AdjustPath(dt.Rows(0)("Empfänger")) & ".xlsx" 'While System.IO.File.Exists(Path) ' Path = sPath & If(nodata, "nodata_", "") & "FA_Graz_" & AdjustPath(dt.Rows(0)("Empfänger")) & "_" & Now.ToString("ddMMyyyyHHmmss") & ".xlsx" 'End While 'My.Computer.FileSystem.WriteAllBytes(Path, My.Resources.FA_Graz_EV_Veranlagung_Muster, False) Catch ex As System.Exception ' MsgBox(ex.Message) MsgBox("ERROR 01: " & ex.Message & vbNewLine & ex.StackTrace) Exit Sub End Try With exclApp .Visible = False Datei = .Workbooks.Open(Path) Blatt = Datei.Worksheets(1) Blatt.Range("A2").Value = EmpfName & " / Finanzamt Graz " & datAuswertVon.Value.ToShortDateString & "-" & datAuswertBis.Value.ToShortDateString 'Blatt.Range("A2").Value = dt.Rows(0)("Empfänger") & " / Finanzamt Graz " & datAuswertVon.Value.ToShortDateString & "-" & datAuswertBis.Value.ToShortDateString If Not nodata Then Dim cnt = 8 Dim cnt_zeile = 1 For Each r In dt.Rows lblCnt2.Text = cnt_zeile & "/" & dt.Rows.Count Dim SPEDBUCH As New VERAG_PROG_ALLGEMEIN.cSpeditionsbuch(r("FilialenNr"), r("AbfertigungsNr"), r("UnterNr")) If SPEDBUCH.hasEntry Then 'LRN Dim BezugsNr = If(SPEDBUCH.AtlasBezNrEZA, "") If BezugsNr = "" Then BezugsNr = SPEDBUCH.FilialenNr & "/" & SPEDBUCH.AbfertigungsNr 'Handelsrechnungen Dim handelsrechnungen = "" : Dim semi = "" 'EUST Dim EUST_Basis As Double = 0 Dim EUST_5EV As Double = 0 Select Case r("FilialenNr") Case "5501" 'EUST Dim dtEUST = SQL.loadDgvBySql(" select sum(base) Base,sum(Amnt)Amnt FROM tblTelotec_Anmeldung as TC inner join tblTelotec_PositionsdatenAbgaben as AGB on AGB.telposAbg_telanmId=TC.telanm_id where Ty IN ('5EV') and tc.telanm_BezugsNr LIKE '" & BezugsNr & "' AND telanm_Status between 50 and 60", "FMZOLL") If dtEUST IsNot Nothing AndAlso dtEUST.Rows.Count >= 0 Then If dtEUST(0)("Base") IsNot DBNull.Value Then EUST_Basis = dtEUST(0)("Base") If dtEUST(0)("Amnt") IsNot DBNull.Value Then EUST_5EV = dtEUST(0)("Amnt") End If 'Handelsrechnungen For Each rg In SQL.DLookupArray("distinct([DocCerts_DRef]) ", "[tblTelotec_PositionsdatenDokumente] As DOC inner join tblTelotec_Anmeldung As ANM ON telanm_id=[telposAbg_telanmId]", " (ANM.Refs_LRN = '" & BezugsNr & "') and [DocCerts_DocCd] IN ('N380','N325')", "FMZOLL", "DocCerts_DRef") handelsrechnungen &= semi & rg : semi = "," Next Case Else 'EUST Dim dtEUST = SQL.loadDgvBySql("select sum(base) Base,sum(Amnt)Amnt FROM ztIMsgGdsItemDutyCalc as GDS inner join zzAktivitaet as AKT on GDS.OperatorID=AKT.OperatorID AND GDS.LizenzNr=AKT.LizenzNr AND GDS.IMsgID=AKT.IMsgID inner join zsAnmRefs as ANM on ANM.LizenzNr=AKT.LizenzNr And ANM.OperatorID=AKT.OperatorID And ANM.AnmID=AKT.AnmID where Ty IN ('5EV') and LRN LIKE '" & BezugsNr & "' AND ErledigungsTypID LIKE 'F%'", EZOLL_SQLSRV) If dtEUST IsNot Nothing AndAlso dtEUST.Rows.Count >= 0 Then If dtEUST(0)("Base") IsNot DBNull.Value Then EUST_Basis = dtEUST(0)("Base") If dtEUST(0)("Amnt") IsNot DBNull.Value Then EUST_5EV = dtEUST(0)("Amnt") End If 'Handelsrechnungen For Each rg In SQL.DLookupArray("distinct(DRef)", "[zsAnmGdsItemDocCerts] As DOC inner join zsAnmRefs As ANM On ANM.LizenzNr=DOC.LizenzNr And ANM.OperatorID=DOC.OperatorID And ANM.AnmID=DOC.AnmID", "(LRN = '" & BezugsNr & "') and DocCd IN ('N380','N325')", EZOLL_SQLSRV, "DRef") handelsrechnungen &= semi & rg : semi = "," Next End Select If SPEDBUCH.ENDEMPFAENGER.Count > 0 Then Dim cnt2 = 0 For Each EEMPF In SPEDBUCH.ENDEMPFAENGER Blatt.Range("A" & cnt).EntireRow.Copy() Blatt.Range("A" & cnt).EntireRow.Insert(Microsoft.Office.Interop.Excel.XlDirection.xlDown) Blatt.Range("A" & cnt).Value = SPEDBUCH.FilialenNr & "/" & SPEDBUCH.AbfertigungsNr Blatt.Range("B" & cnt).Value = SPEDBUCH.Abfertigungsdatum Blatt.Range("C" & cnt).Value = handelsrechnungen If cnt2 = 0 Then 'Nur oberste Zeile je Abfertigung Blatt.Range("D" & cnt).Value = EUST_Basis Blatt.Range("E" & cnt).Value = EUST_5EV 'Blatt.Range("D" & cnt).Value = EUST_Basis.ToString("0.00") 'Blatt.Range("E" & cnt).Value = EUST_5EV.ToString("0.00") 'Blatt.Range("D" & cnt).Style.NumberFormat = "###,###,##0.00 €" 'Blatt.Range("E" & cnt).Style.NumberFormat = "###,###,##0.00 €" Else Blatt.Range("D" & cnt).Value = "-" Blatt.Range("E" & cnt).Value = "-" End If Blatt.Range("F" & cnt).Value = EEMPF.EndEmpfaenger Blatt.Range("G" & cnt).Value = If(EEMPF.UstIdKz, "") & If(EEMPF.UstIdNr, "") If EEMPF.Rechnungsbetrag IsNot Nothing AndAlso IsNumeric(EEMPF.Rechnungsbetrag) Then Blatt.Range("H" & cnt).Value = CDbl(EEMPF.Rechnungsbetrag) 'Blatt.Range("H" & cnt).Value = CDbl(EEMPF.Rechnungsbetrag).ToString("0.00") 'Blatt.Range("H" & cnt).Style.NumberFormat = "###,###,##0.00 €" End If cnt += 1 cnt2 += 1 '+Zeile Next Else Blatt.Range("A" & cnt).EntireRow.Copy() Blatt.Range("A" & cnt).EntireRow.Insert(Microsoft.Office.Interop.Excel.XlDirection.xlDown) Blatt.Range("A" & cnt).Value = SPEDBUCH.FilialenNr & "/" & SPEDBUCH.AbfertigungsNr Blatt.Range("B" & cnt).Value = SPEDBUCH.Abfertigungsdatum Blatt.Range("C" & cnt).Value = handelsrechnungen Blatt.Range("D" & cnt).Value = EUST_Basis Blatt.Range("E" & cnt).Value = EUST_5EV 'Blatt.Range("D" & cnt).Value = EUST_Basis.ToString("0.00") 'Blatt.Range("E" & cnt).Value = EUST_5EV.ToString("0.00") 'Blatt.Range("D" & cnt).Style.NumberFormat = "###,###,##0.00 €" 'Blatt.Range("E" & cnt).Style.NumberFormat = "###,###,##0.00 €" cnt += 1 '+Zeile End If End If cnt_zeile += 1 Next End If Datei.Save Datei.Close ' .Visible = True 'TEST End With Catch ex As Exception MsgBox(ex.Message & ex.StackTrace) End Try End Sub Private Function AdjustPath(Input As String) As String Return System.Text.RegularExpressions.Regex.Replace(Input, "[\\/:*?""<>|]", String.Empty) End Function Private Sub Nctstr_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cboMonat.SelectedIndexChanged, txtJahr.ValueChanged If cboMonat.SelectedIndex <= 0 Then Exit Sub Dim d As Date = CDate("01." & (cboMonat.SelectedIndex) & "." & txtJahr.Text) datAuswertVon.Value = d datAuswertBis.Value = d.AddMonths(1).AddDays(-1) End Sub End Class