Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 67786 Skopiuj do schowka [VPN] wysyłanie maili Excel->Outlook
Autor Wiadomość
analyzer64 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 08-04-2020, 13:55   [VPN] wysyłanie maili Excel->Outlook

Cześć,
mam makro w Excel, które wysyła mi maila z załącznikiem. Wysyłka idzie ze skrzynki współdzielonej w pracy.

Będąc w pracy połączonym po kablu, wysyłka działała, od momentu jak przyszedłem na pracę zdalną (łączenie za pośrednictwem VPN Cisco) to nie mogę realizować wysyłki.

Błąd w załączniku.

Po wybraniu Debug, podświetla mi linię z .Send

Po zmianie na .Display, jestem w stanie wysłać kilka wiadomości, do momentu aż nie natrafię na maila w domenie, wp.pl ; onet.pl; op.pl. To co jest na gmail.com to działa.


Próbowałem też z .Recipients.ResolveAll, ale to nie pomaga.

Napisałem też do IT, czy nie ma jakiejś blokady i tu czekam na odpowiedź.

Spotkał się ktoś z czymś takim?

Wrzucam kod:
Kod:
Sub Send_Files()
 'Working in 2000-2010
        Dim OutApp As Outlook.Application
        Dim OutMail As Outlook.MailItem
        Dim sh As Worksheet
        Dim cell As Range, FileCell As String, rng As Range
        Dim w As Integer
        Dim I As Integer
        Dim AccountToSendFrom As String
       
        I = 2 ' numer konta do wysyłki

        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With

        Set sh = Sheets("Arkusz1")

        'Set OutApp = CreateObject("Outlook.Application")
        Set OutApp = Outlook.Application
        OutApp.Session.Logon
       
        FileCell = Range("H2")
       
                'For I = 1 To OutApp.Session.Accounts.Count
                    'MsgBox "Dostępne konta do wysyłki to " & OutApp.Session.Accounts.Item(I) & " : o numerze " & I
                'Next I
       
        Wysylka = MsgBox("Czy chcesz wysłać maile z konta " & OutApp.Session.Accounts.Item(I), vbYesNo + vbQuestion, "Konto wysyłki")
        If Wysylka = 7 Then
        Exit Sub
        Else
        w = 0
        For Each cell In sh.Columns("E").Cells.SpecialCells(xlCellTypeConstants)

            'Enter the file names in the C:Z column in each row
           
            Set rng = sh.Cells(cell.Row, 3).Range("C1:C1")

                strbody = "jakaś treść"



            If cell.Value Like "?*@?*.?*" And Cells(cell.Row, 7).Value = "OK" And _
               Application.WorksheetFunction.CountA(rng) > 0 Then
                'Set OutMail = OutApp.CreateItemFromTemplate("C:\Users\Desktop\Twoj szablon.oft") 'zmodyfikuj sciez.ke;
                Set OutMail = OutApp.CreateItem(0)
                 
                'Set OutMail = OutApp.Session.Accounts.Item(1)
               
                With OutMail
                    .To = cell.Value
                    .Subject = "Faktura " & Cells(cell.Row, 3) & " " & Cells(cell.Row, 10)
                   '.HTMLBody = "" & cell.Offset(0, -1).Value & vbNewLine & .HTMLBody
                   .HTMLBody = strbody '& "<br>" & .HTMLBody
                   .Recipients.ResolveAll
                    .SendUsingAccount = OutApp.Session.Accounts.Item(I)

                    'For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                        If Trim(FileCell) <> "" Then
                            If Dir(FileCell) <> "" Then
                                '.Attachments.Add FileCell & Cells(cell.Row, 3) & ".pdf"
                                   If Range("G3") = "Stary" Then
                                        .Attachments.Add FileCell & "Dokument VAT I - " & Replace(Cells(cell.Row, 3).Value, "/", " ") & ".pdf"
                                    Else
                                        .Attachments.Add FileCell & Cells(cell.Row, 3).Value & ".pdf"
                                    End If
                                    'MsgBox FileCell & "Dokument VAT I - " & Replace(Cells(cell.Row, 3).Value, "/", " ") & ".pdf"
                                    If Range("H12") = "sieć preferowana" And Cells(cell.Row, 9).Value = "OK" Then
                                    'MsgBox FileCell & "Dokument VAT I - " & Replace(Cells(cell.Row, 3).Value, "/", " ") & ".pdf"
                                    .Attachments.Add FileCell & Dir(FileCell & Cells(cell.Row, 1).Value & "*" & ".pdf")
                                    End If
                            End If
                        End If
                    'Next FileCell
                   
                   'flagowanie wiadomości
        '.FlagRequest = "Follow up"
       
        ' ustawienie przypominacza na 2 dni od dzisiaj
        '.FlagDueBy = DateAdd("d", 2, Date) 'ewentualnie na konkretną datę
        '.FlagDueBy = "2019-04-05 08:25"
                   
                    '.Display
                    .Send  'Or use Display
                    sh.Cells(cell.Row, 8) = Now()
                    w = w + 1
                    If Range("G3") = "Stary" Then
                        Kill FileCell & "Dokument VAT I - " & Replace(Cells(cell.Row, 3).Value, "/", " ") & ".pdf"
                        Else
                        Kill FileCell & Cells(cell.Row, 3).Value & ".pdf"
                    End If
                    If Range("H12") = "sieć preferowana" Then
                    Kill FileCell & Dir(FileCell & Cells(cell.Row, 1).Value & "*" & ".pdf")
                    End If
                End With

                Set OutMail = Nothing
            End If
        Next cell

       Set OutApp = Nothing
        MsgBox "Wysłano " & w & " maili", vbExclamation
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        End If
    End Sub


blad_vba.png
Plik ściągnięto 262 raz(y) 6.23 KB

ID posta: 385239 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 718 razy
Posty: 3871
Wysłany: 08-04-2020, 16:02   

IMHO: NTF (Nie To Forum) - o ile w ogóle jakieś forum a nie administrator sieci.

Nie widzę tu "winy" Excel. Bez znajomości topografii sieci / uprawnień / ... nikt ci raczej nie pomoże.
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 385253 Skopiuj do schowka
 
 
analyzer64 
Starszy Forumowicz


Wersja: Win Office 2019
Posty: 44
Wysłany: 08-04-2020, 16:38   

Domyślam się, że problem tkwi gdzieś w sieci. Wyłączyłem buforowanie skrzynki i o dziwo błąd wyskakuje rzadziej niż z włączonym buforowaniem.
ID posta: 385258 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe