Возникла очень интересная задача по обработке входящей почты, решением которой хотелось бы поделиться.

Нужно чтобы файлы из входящих писем, которые либо в теле письма, либо в теме, либо в названии файла содержат ИНН, сохранялись в папке с номером ИНН. Кроме того требуется ведения лога поступающих ИНН в отдельном файле.

Эту задачу можно разделить на следующие части:

  • Автоматическое копирование вложений из писем в папку (скрипт решающий эту задачу я уже публиковал)
  • Поиск ИНН в теме письма, теле письма или в названии вложений. Это проще всего сделать с помощью регулярных выражений.
  • Проверка ИНН по контрольному числу
  • Запись информации в лог

Кроме того, в ходе работы над скриптом я заметил ещё одну проблему. Если письмо в формате HTML и в его оформлении используются вложенные картинки, то при попытке сохранить все вложения, эти картинки сохранятся как и остальные файлы. Что не верно. Поэтому нужно ещё отличать видимые и скрытые вложения в письмах и сохранять только видимые.

Продолжить чтение »

Теги:
 

Есть несколько способов поиска определённого текста в теле письма с помощью VBA. Можно воспользоваться функциями InStr, Len, Left или Right, чтобы найти и извлечь текст, а можно воспользоваться регулярными выражениями. Именно о применении регулярных выражений в коде VBA пойдёт речь в данной статье.

Например, требуется извлечь код отслеживания посылки UPS, отправленной с Amazon.com. Такой код имеет формат как на скриншете ниже:

tracking-code-sample-regexp

Нужно находить в тексте слова “Carrier Tracking ID”, затем, возможно, пробел и двоеточие.

.Pattern = "(Carrier Tracking ID\s*[:]+\s*(\w*)\s*)"

Такое выражение извлечёт из текста из примера цифро-буквенный код 1Z2V37F8YW51233715.

Продолжить чтение »

Теги:
 

Возникла следующая задача:

Нужно открыть сообщение Outlook, хранящиеся в определенной папке, а затем получить вложения из этого сообщения и сохранить его.

Это можно сделать, используя Windows Scripting Host и метод Application.CreateItemFromTemplate для открытия сообщений. После открытия, можно сохранить вложения или делать все, что нужно сделать с сообщением.

Продолжить чтение »

Теги:
 

Работа с задачами Outlook из Excel

25 апреля 2013, VBA, Konstantin

Получать информацию о выполненных и будущих задачах, распланированных в соответствующем разделе Outlook, можно с помощью кода из этой статьи. Может, например, пригодиться для автоматического формирования перечня задач находящихся в работе и уже исполненных.

Private Sub LoadTask()
Dim fTasks As Outlook.MAPIFolder
Dim Tasks As Outlook.Items
Set fTasks = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks)
Set Tasks = fTasks.Items
Tasks.Sort "[StartDate]", True
For i = 1 To Tasks.Count
	'Тема задачи
	ActiveSheet.Range("A" & i).Value = _
	   Replace(Trim(Tasks(i).Subject), Chr(10), " ")
	'Статус задчи
	If Tasks(i).Complete Then 
		ActiveSheet.Range("B" & i).Value = "Завершена" 
	Else
		ActiveSheet.Range("B" & i).Value = "В работе" 
	End If
	'Тип задчи
	If Tasks(i).IsRecurring Then 
		ActiveSheet.Range("C" & sr).Value = "Регулярная задача"
	Else
		ActiveSheet.Range("C" & sr).Value = "Единичная задача"
	End If
	ActiveSheet.Range("D" & sr).Value = Tasks(i).StartDate
	'Срок окончания задачи
	ActiveSheet.Range("E" & sr).Value = Tasks(i).DueDate 
	'Дата выполнения
	ActiveSheet.Range("F" & sr).Value = Tasks(i).DateCompleted
	'Описание задачи 
	ActiveSheet.Range("G" & sr).Value = Tasks(i).Body 
	ActiveSheet.Range("H" & sr).Value = Tasks(i).Owner
Next i
End Sub

Продолжить чтение »

Теги:
 

CheckBox в ячейках Excel

25 апреля 2013, VBA, Konstantin

Следующий код, помещённый в VBA редакторе на соответствующий лист, позволяет двойным кликом левой кнопки мыши по ячейке в первом столбце устанавливать в ней попеременном галочку, либо крестик.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 With Target
     If .Column = 1 Then
         Select Case .Value
                Case Is = "a"
                     .Font.Name = "Marlett"
                     .Value = "r"
                 Case Is = "r"
                     .Font.Name = "Marlett"
                     .Value = "a"
                 Case Else
                     .Font.Name = "Marlett"
                     .Value = "a"
         End Select
     Cancel = True
     End If
 End With
End Sub

Результат работы макроса выглядит следующим образом:

Excel_CheckBox
Источник

Теги:
 

Если, например, требуется получить одно единственное значение с помощью запроса к базе данных (сам запрос может иметь заранее заданную конструкцию, меняющуюся в зависимости от определённых условий), то пригодится следующией код.

Для MS SQL

Sub Get_MSSQL_Data()
 Dim db As ADODB.Connection
 Dim rs As ADODB.Recordset
 Dim sqlStr As String
 Set rs = CreateObject("ADODB.Recordset")
 Set db = New ADODB.Connection
 db.Open _
  "DRIVER={SQL Server};SERVER=SName;UID=UserName;PWD=Password;DATABASE=DBName"
 
 sqlStr = "SELECT Count(*) as cnt FROM [DBName].[DB].[Table]"
 rs.Open sqlStr, db
 
 While Not rs.EOF
    str1 = rs.Fields("cnt").Value
    rs.MoveNext
    Wend
 rs.Close
 db.Close
End Sub

Продолжить чтение »

Теги:
 

Задача: Есть набор целых чисел (числа не повторяются)

1	3	5	7	8	9	11	2	25	30

Необходимо в Excel написать макрос, который выводит на лист “Результат” все комбинации чисел из набора, дающие в сумме 40. Каждое число можно использовать один раз. Полный перебор комбинаций нежелателен.

Дано: Книга Excel, сотоящая из двух листов. На первом листе (sh1) во второй строке располагается набор целых чисел, а в четвертой строке – необходимая сумма. На втором листе (sh2) будут хранится временные массивы и итоговый результат.

Продолжить чтение »

Теги:
 

Нижеследующий код позволяет создать новую книгу Excel из листов текущей книги, содержащей макросы. Также удаляются ненужные кнопки.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub ToNewFile()
 pathNewBook = "C:\Temp\" 'Путь сохранения новой книги
 nameNewBook = "Название книги (" & Format(Now, "MMMM YYYY") & ").xlsx"
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Application.SheetsInNewWorkbook = 1 'Количество листов в новой книге
 Set NewWB = Workbooks.Add
 ThisWorkbook.Activate
 Sheets("Лист 1").Copy Before:=NewWB.Sheets(1)
 NewWB.Sheets(2).Delete
 'Удаляем кнопки
 NewWB.Sheets("Лист 1").Shapes.Range(Array("cbButtonName")).Delete
 NewWB.SaveAs Filename:=pathNewBook & nameNewBook
 NewWB.Close True 'Сохраняем
 Application.CutCopyMode = False
 If Dir(pathNewBook & nameNewBook) <> "" Then
  MsgBox "Создан файл: " & pathNewBook & nameNewBook
 Else
  MsgBox "Не удалось создать файл!"
 End If
End Sub
Sub ToNewFile()
 pathNewBook = "C:\Temp\" 'Путь сохранения новой книги
 nameNewBook = "Название книги (" & Format(Now, "MMMM YYYY") & ").xlsx"
 Application.ScreenUpdating = False
 Application.DisplayAlerts = False
 Application.SheetsInNewWorkbook = 1 'Количество листов в новой книге
 Set NewWB = Workbooks.Add
 ThisWorkbook.Activate
 Sheets("Лист 1").Copy Before:=NewWB.Sheets(1)
 NewWB.Sheets(2).Delete
 'Удаляем кнопки
 NewWB.Sheets("Лист 1").Shapes.Range(Array("cbButtonName")).Delete
 NewWB.SaveAs Filename:=pathNewBook & nameNewBook
 NewWB.Close True 'Сохраняем
 Application.CutCopyMode = False
 If Dir(pathNewBook & nameNewBook) <> "" Then
  MsgBox "Создан файл: " & pathNewBook & nameNewBook
 Else
  MsgBox "Не удалось создать файл!"
 End If
End Sub

Продолжить чтение »

Теги:
 

Создание примечания для ячейки в Excel с помощью макроса, которое также имело бы сложное внутреннее форматирование, не самая тривиальная задача. Для этого можно воспользоваться например таким кодом:

With Worksheets(1).Cells(4, 12).Comment
   .Visible = False
   .Text "Жирный шрифт:" & Chr(10) & "курсив"
   .Shape.DrawingObject.Characters(1, 13).Font.Bold = True
   .Shape.DrawingObject.Characters(15, 20).Font.Italic = True
End With

В итоге получится примерно такое примечание:

Форматированное примечание ячейки

Продолжить чтение »

Теги:
 

В Excel 2010 нужно выбрать в меню Файл-> Параметры-> Формулы-> раздел: Работа с формулами-> Стиль ссылок R1C1.

Либо воспользоваться макросом:

Private Sub Change_ColStyle()
If Application.ReferenceStyle = xlA1 Then
   Application.ReferenceStyle = xlR1C1
Else
   Application.ReferenceStyle = xlA1
End If
End Sub

Как изменить заголовки столбцов в Excel 2007 и 2003: Excel — это не сложно!

Продолжить чтение »

Теги:
 

Задача переноса графиков, диаграмм, таблиц из Excel в презентацию PowerPoint осложняется тем, что в последних версиях редактора презентаций (2007, 2010) разработчики убрали возможность записи производимых действий в макрос. Поэтому, для настройки внешнего вида презентации под собственные условия, нужно перерыть документацию по VBA для PowerPoint, либо просмотреть множество специализированных форумов. Ниже приведен код примера создания презентации из диаграмм Excel.

Private Sub export_to_pp()
Set pr = CreateObject("PowerPoint.Application")
Set mpr = pr.Presentations.Add
'Определение имени создаваемой презентации
ppName = "Имя_для_презентации"
'Добавление пустого слайда
Set ppSlide = mpr.Slides.Add(mpr.Slides.Count, ppLayoutBlank)
'Цвет фона слайда
ppSlide.Master.Background.Fill.ForeColor.RGB = RGB(200, 200, 200)
'Добавление блока (Orientation, Left, Top, Width, Height)
'функция Application.CentimetersToPoints переводит сантиметры в пиксели
Set TextShape = ppSlide.Shapes.AddTextbox(1, _
   Application.CentimetersToPoints(1.09), _
   Application.CentimetersToPoints(1.2), _
   Application.CentimetersToPoints(22.86), _
   Application.CentimetersToPoints(1.2))
TextShape.TextFrame.TextRange.Text = "Текст надписи"
'Настройка параметров блока с текстом
TextShape.TextFrame.TextRange.Font.Name = "Calibri"
TextShape.TextFrame.TextRange.Font.Size = 18
TextShape.TextFrame.TextRange.Font.Bold = True
'Отключение автоматического подгона размера блока под текст
TextShape.TextFrame.AutoSize = 0
TextShape.Height = Application.CentimetersToPoints(1.2)
TextShape.TextFrame.TextRange.Font.Color = vbWhite
'Вертикальное выравнивание текста по центру
TextShape.TextFrame.VerticalAnchor = msoAnchorMiddle
'Копируем диаграмму в PowerPoint
ListName.ChartObjects("ChartName").Copy
Set chart1 = ppSlide.Shapes.PasteSpecial(ppPastePNG)
   chart1.Left = Application.CentimetersToPoints(1.52)
   chart1.Top = Application.CentimetersToPoints(3.65)
'Копируем таблицу как OLE object
ListName.Range("H51:M60").Copy
Set table1 = ppSlide.Shapes.PasteSpecial(ppPasteOLEObject)
   table1.Left = Application.CentimetersToPoints(1.52)
   table1.Top = Application.CentimetersToPoints(13.72)
'Копируем таблицу как рисунок
ListName.Range("H61:M70").Copy
Set table2 = ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile)
   table2.Left = Application.CentimetersToPoints(13.16)
   table2.Top = Application.CentimetersToPoints(13.72)
Application.CutCopyMode = False
'Сохраняем презентацию в папке с текущей книгой Excel
mpr.SaveAs (ThisWorkbook.Path + "\" + ppName)
mpr.Close
pr.Quit
End Sub

Продолжить чтение »

Теги:
 

При запуске файла из локальной или глобальной сети, содержащего макрос, может появляться данная ошибка. Причём ошибка появляется сразу же после нажатия кнопки «Разрешить редактирование» в сообщении «Защищенный просмотр».

Разрешить редактирование

При повторном запуске файла ошибка уже не возникает (как и не появляется сообщение о «Защищенном режиме»). При выяснении причины проблемы, дебаггер выделяет строчку в коде, отвечающую за активацию одного из листов книги Excel: Sheets("Лист 1").Activate.

Решение: в свойствах файла Excel на вкладке «Общие» нужно нажать кнопку «Разблокировать» рядом с предупреждением:

Этот файл получен с другого компьютера и, возможно, был заблокирован с целью защиты компьютера

Теги:
 

Задача: необходимость добавить к графику горизонтальную линию на уровне определенного значения одной из осей. Для решения этой задачи можно либо составить ряд одинаковых чисел и добавить соответствующий график на диаграмму, либо воспользоваться VBA:

Const Num = 0.8 'Значение уровня
Dim objSeries As Series
Dim arrValues()
ActiveWorkbook.Sheets("Имя_листа").ChartObjects("Имя_диаграммы").Activate
arrValues = ActiveChart.SeriesCollection(1).Values
For i = LBound(arrValues) To UBound(arrValues)
   arrValues(i) = Num
Next
Set objSeries = ActiveChart.SeriesCollection.NewSeries
objSeries.Values = arrValues
objSeries.ChartType = xlLine

Источник: Форум программистов

Продолжить чтение »

Полезные команды VBA

15 февраля 2012, VBA, Konstantin

Пополняемый список полезных отрывков кода VBA для выполнения часто востребованных действий в MS Excel.

Служебные команды для ускорения скорости выполнения макроса:

'Отключение отображения выполняемых действий
Application.ScreenUpdating = False
'Предотвращение появления предупреждающих сообщений
Application.DisplayAlerts = False
'Предотвращение появления предупреждения об обновлении связей данных
Application.AskToUpdateLinks = False
'Очистка буфера обмена
Application.CutCopyMode = False

Продолжить чтение »

Теги:
 

Если после выполнения макроса необходимо отправить в качестве вложения получившийся документ Excel, можно использовать следующий код. Он создаёт письмо с нужным перечнем адресатов в полях «Кому» и «Копия», с указанной темой, текстом и прикреплённым Excel файлом. Остаётся толкьо дописать письмо в случае необходимости и нажать кнопку «Отправить».

Dim OutlookApp As Object, SM As Object
 Set OutlookApp = CreateObject("Outlook.Application")
 Set SM = OutlookApp.CreateItem(olMailItem)
 SM.To = "mail@example.ru" 'Поле "Кому"
 SM.CC = "mail@example.ru" 'Поле "Копия"
 SM.Subject = "Тема письма"
 On Error Resume Next
 SM.Body = "Текст письма"
 SM.Attachments.Add ("C:\Test.xls") 'Адрес вложения
 SM.Display
 Set SM = Nothing
 Set OutlookApp = Nothing

Продолжить чтение »

Теги:
 

Задача: скопировать заданную область из таблицы Excel в текстовый файл. Данные из столбцов должны разделяться знаками табуляции, данные из строк – находиться в отдельных строках.

Продолжить чтение »

Теги:
 

Для автоматического копирования вложений из приходящих в Outlook писем в указанную папку можно воспользоваться правилом, исполняющим ниже прописанный скрипт VBA. Скрипт также модифицирует имя файла в соответствии с датой создания письма. Вариант из примера работает корректно для писем с одним вложением. Для писем с несколькими вложениями нужно изменить код в месте формирования имени файла.

Продолжить чтение »

Теги: