Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Автоподхват excel vba вложений с неизвестным окончанием
 
#1
17.05.2021 15:10:26
добрый день кто то может подсказать  с именами подхватом файлов
Код
?
1
sAttachment = "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Eeno1").Range("A1") & "1232.xml"
но последние 4 знака динамические и меняются постоянно
& "****.xml"
& "*.xml"
пробовал менять концовки на **** но тогда подхват файла идет если есть в конце названия ****
как правильно прописать рандомное окончание чтоб не делать дубликаты
Код
?
1
2
3
sAttachment = "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Eeno1").Range("A1") & "1232.xml"
sAttachment = "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Eeno1").Range("A1") & "1233.xml"  
sAttachment = "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Eeno1").Range("A1") & "1234.xml"
то есть как правильное прописать чтоб захватывал любой файл в котором есть начало  
Код
?
1
sAttachment = "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Eeno1").Range("A1")
и любое окончание из 4 символов "1234.xml"  
Изменено: splashsnake - 17.05.2021 16:54:45
 
 
 
#2
17.05.2021 15:37:03
splashsnake, Ну так подставьте одну звездочку и проверяйте на количество символов в имени файла (полном или неполном).
Либо используйте вместо ****  ####.
Изменено: skais675 - 17.05.2021 15:41:21
Мой канал
 
 
 
#3
17.05.2021 16:03:50
пробывал менять по разному:
Код
?
1
2
3
4
5
sAttachment = ...& "****.xml"
sAttachment = ...& "####.xml"
sAttachment = ...& "*.xml"
sAttachment = ...& "****"&".xml"
sAttachment = ...& "####"& ".xml"

не подхватывает файл, а если конкретно указывать  1234 то идет подхват файла или любые другие
Код
?
1
2
sAttachment =...& "1234"& ".xml"
sAttachment = "E:\имя1\имяфайла_"&"1234"&".xml"

1234 - ****
1234 - ####
если я прописываю ####  или  **** то он ищет в названии файла  **** или #### то есть файл называется
Код
?
1
sAttachment = "E:\имя1\имяфайла_"&"####"&".xml"  а не sAttachment = "E:\имя1\имяфайла_"&"1234"&".xml"

и не подкрепляет его
 
 
 
#4
17.05.2021 16:12:56
splashsnake, Выложите пример файла или полный код этого блока.
Мой канал
 
 
 
#5
17.05.2021 16:53:34
файл прикрепил
строка в модуле  sAttachment = "C:\GOODSANDGROUPS_Import_AddOrUpdate_20210517####" & ".xml"  'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
убираем #### на нужные цифры работает
Option Explicit
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub Send_Mail()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
  
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть)
    '   [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии]
    'objOutlookApp.Session.Logon "profile","1234",False, True
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
  
    sTo = ""    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Автоотправка"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Привет от Excel-VBA"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "C:\GOODSANDGROUPS_Import_AddOrUpdate_20210517####" & ".xml"  'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
  
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        'добавляем вложение, если файл по указанному пути существует(dir проверяет это)
        If sAttachment <> "" Then
            If Dir(sAttachment, 16) <> "" Then
                .Attachments.Add sAttachment 'просто вложение
                'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
            End If
        End If
        .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
  
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub
   
Изменено: splashsnake - 17.05.2021 17:43:14
 
 
 
#6
17.05.2021 17:04:01
splashsnake, А теперь расскажите, по какому принципу макрос должен понимать какой файл должен забирать, может их там у Вас несколько и что тогда?
Изменено: skais675 - 17.05.2021 17:04:44
Мой канал
 
 
 
#7
17.05.2021 17:19:48
С сервера подгружаться выгрузки с определенным названием датой и временем. время выгрузки в сетевую папку рандомное т.е. последний 4 символа неизвестный.
.файл с сервера выгружается один с уникальным названием

код примера с прикреплением нескольких файлов. тут с условием если вложение не пусто то поиск следующих вложений. список вложений сократил чтоб не был очень длинный код
Код
?
1
.attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1543.xml"

суть полного кода при пк врубается по времени через 5 мин срабатывает макрос который отправляет сообщение с вложением а затем вырубается пк
скидывал первичный код так как одно вложение с неизвестными последними 4 символами
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub Send_Mail_1()
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
 
    Application.ScreenUpdating = False
    On Error Resume Next
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    'раскомментировать строку, если в Outlook несколько учетных записей и нужно подключиться к конкретной(только если Outlook закрыть)
    '   [параметры]: Session.Logon "имя профиля","пароль",[показывать окно выбора профиля], [запускать в новой сессии]
    'objOutlookApp.Session.Logon "profile","1234",False, True
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
 
    sTo = ""    'Кому(можно заменить значением из ячейки - sTo = Range("A1").Value)
    sSubject = "Автоотправка tns"    'Тема письма(можно заменить значением из ячейки - sSubject = Range("A2").Value)
    sBody = "Добрый день! прилагаю выгрузку tns. Excel-VBA ежедневная автоматическая отправка на данное сообщение просьба не отвечать. Обновление: файл check.txt необходим для подхвата нескольких файлов"    'Текст письма(можно заменить значением из ячейки - sBody = Range("A3").Value)
    sAttachment = "C:\1\check.txt"     'Вложение(полный путь к файлу. Можно заменить значением из ячейки - sAttachment = Range("A4").Value)
 
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии avsemashko@oilmurman.ru
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        'добавляем вложение, если файл по указанному пути существует(dir проверяет это)
        If sAttachment <> "" Then
            If Dir(sAttachment, 16) <> "" Then
                .attachments.Add sAttachment  'просто вложение
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1544.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1545.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1546.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1543.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1547.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1144.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1145.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1146.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1147.xml"
                .attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1153.xml"
 
                'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
            End If
        End If
        .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра
    End With
это решение если несколько файлов но имя так же полностью прописанно
 
 
 
#8
17.05.2021 17:22:58
макрос должен понимать по первоначальному имени файла
Код
?
1
2
3
4
5
.attachments.Add "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "1544.xml"
 
' т.е  если содержит начало .attachments.Add "\\10.35.24.68\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & ".xml"
' прикрепляет любой файл из папки с началом названия .attachments.Add "\\10.35.24.68\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & ActiveWorkbook.Sheets("Лист1").Range("A1") & "****.xml"
' с последними любыми цифрами
 
 
 
 
#9
17.05.2021 17:24:40
Не до конца понял - нужно все файлы отправлять или как?
Мой канал
 
 
 
#10
17.05.2021 17:27:58
один файл но последние 4 символа рандомные
прописано много вложений чтоб он нашел нужный один файл. то есть одна и та-же строка дублируется с разными окончаниями 0001;0002;0003, для того что бы он нашел нужный файл с неизвестными последними 4 символами.  
Изменено: splashsnake - 17.05.2021 17:35:19
 
 
 
#11
17.05.2021 17:58:07
А как понять какой из них нужный?
Мой канал
 
 
 
#12
17.05.2021 18:07:08
любой файл из данного диапазона от 0000  до 2459 но файл один. поэтому и ищу помощи как оптимизировать код в строке
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
sAttachment = "C:\1\check1043.txt"
'пример файл в папке "C:\1\check1043.txt"
 
' завтра файл в папке "C:\1\check1158.txt"
 
прописать так не подхватывает файлы
sAttachment = "C:\1\check****.txt"
sAttachment = "C:\1\check####.txt"
sAttachment = "C:\1\check*.txt"
sAttachment = "C:\1\check#.txt"
 
'как прописать чтоб подхватывал любой файлс с названием sAttachment = "C:\1\check****.txt" в котором **** могут быть любые 4 символа
'вот это интересует
если есть любой файл у которого начало идет sAttachment = "C:\1\check*.txt" и + 4 неизвестных символа которые всегда есть
 
 
 
#13
17.05.2021 18:09:33
Как будто о Марсе говорим! Сколько файлов в папке? Если несколько, то как понять какой один из них нужен? Если он там один, тогда берем единственный.
Изменено: skais675 - 17.05.2021 18:11:43
Мой канал
 
 
 
#14
18.05.2021 08:41:37
Функция =DIR("маска имени файла со звездочкой")
вернёт вам название файла

примерно так я бы попробовал:

Код
?
1
2
3
4
sAttachment=""
mask$ = "\\ip\TNS_Loyalty\GOODSANDGROUPS_Import_AddOrUpdate_" & Sheets("Лист1").Range("A1") & "*.xml"
filename$ = dir(mask$)
if len(filename$) then sAttachment = "\\ip\TNS_Loyalty\" & filename$
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#15
20.05.2021 16:23:25
Спасибо огромное
Цитата
Игорь написал:
Функция =DIR("маска имени файла со звездочкой")
спасибо огромное все работает не знал про данную функцию запомню так как можно много где применить.
только уточнить хотел а для чего $ в vba после mask$ и failname$
Код
?
1
2
3
' для ребят новичков не забудьте задать если кому понадобиться данная статья
dim mask as string
dim filename as string
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...