Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
настройка макросов vba после переустановки системы
 
#1
03.04.2024 09:59:36
Добрый день.
После установки Win10 много чего в макросах перестало работать .Не знаю за что хвататься.  Поэтому прошу подсказки уважаемых форумчан, почему вот такая конструкция перестала создавать pdf ?
Ничего не происходит никакой ошибки не выдает, просто не появляется pdf:
Код
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="C:\Users\kols0875\Desktop\показания на " & Date & ".pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
Также перестал вызываться Outlook вот таким кодом:
Код
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
    Shell ("OUTLOOK")
    Application.Wait (Now + TimeValue("0:00:10"))
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
нужно сказать, что установлена win 10, но офис установлен 2007, соответственно версия vba тоже та которая шла с 2007 офисом. Но Outlook установлен 2016.
Заранее спасибо
 
 
 
#2
03.04.2024 10:19:15
Tools>References
При переходе на более раннюю версию там иногда возникают MISSING. Надо руками переназначать.
Правда, в вашем коде не видно ссылок на подключаемые библиотеки, не факт, что именно в этом дело, но посмотреть можно.
 
 
 
#3
03.04.2024 10:24:52
Цитата
МатросНаЗебре: там иногда возникают MISSING
мисинги не только на самих себя влияют. Недавно только сталкивался — мисинг на библу Виталия вызвал сбои при вызове штатных функций типа Format$().

Другое дело, что, в этом случае, вылет в дебаг должен подсветить строку с ненайденным, а ТС говорит, что всё норм. Так что, либо у него обход ошибок, либо я даже не знаю …
Изменено: Jack Famous - 03.04.2024 10:28:17
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#4
03.04.2024 10:31:53
Вроде нет никаких Missing/
Да и наверное ошибку бы выдавал макрос, а так ничего нет , бесшумно завершается, но без результатов. ни pdf не создает, ни outlook не вызывает.
 
 
 
#5
03.04.2024 10:35:06
Цитата
написал:
Filename:="C:\Users\kols0875\Desktop\показания на " & Date & ".pdf", _
А глупый вопрос, имя пользователя не менялось?
 
 
 
#6
03.04.2024 10:37:02
Цитата
john22255 написал:
наверное ошибку бы выдавал макрос
нет. Уберите On Error Resume Next и проверьте работу.
По идее, Outlook можно вызывать всегда методом CreateObject("Outlook.Application") - если он уже запущен, будет подключение к существующему экземпляру. Т.е. проверка через GetObject совершенно не обязательна и для проверки работы кода этот блок можно убрать, оставив лишь нужное:
Код
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
 
    Application.ScreenUpdating = False
    Set objOutlookApp = CreateObject("Outlook.Application")
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение

Возможно, Outlook конфликтует с 2007 офисом или просто "криво" установлен и в итоге подключения просто не происходит.
Тоже самое с PDF - посмотрите, нет ли где выше по коду On Error Resume Next и уберите(или закомментируйте). В 2007 может экспорт не работать, если не подключен специальный PDF принтер. Начиная с 2010 он уже как бы встроен, а в 2007 вроде бы надо было проверять, что он точно есть. Или установить все доступные для офиса обновления - в каком-то из них накатывался этот принтер вроде бы.
Изменено: Дмитрий(The_Prist) Щербаков - 03.04.2024 10:41:57
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#7
03.04.2024 10:39:32
Цитата
написал:
у него обход ошибок
ну есть, да.
А как выложить код на форум, чтобы кирилические символы нормально отображались?
 
 
 
#8
03.04.2024 10:40:02
Цитата
написал:
имя пользователя не менялось
неа
 
 
 
#9
03.04.2024 10:41:29
Цитата
написал:
А как выложить код на форум, чтобы кирилические символы нормально отображались?
Переключите на русскую раскладку. И потом копируйте.
 
 
 
#10
03.04.2024 10:46:10
Код
Sub Передача()


'
'

'
  Dim k As Integer, i As Integer, z As Integer, Mass As Variant

    
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "для отправки в СетиНикеля"
    ' создаём папку для файла, если её ещё нет
    'On Error Resume Next
    MkDir ActiveWorkbook.Path & "\" & REPORTS_FOLDER
    
    ' выбираем стартовую папку
    ChDrive Left(ActiveWorkbook.Path, 1): ChDir ActiveWorkbook.Path & "\" & REPORTS_FOLDER
 
    ' вывод диалогового окна для запроса имени сохраняемого файла
    
    
'ActiveWindow.SelectedSheets.PrintOut Copies:=1
 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="C:\Users\kols0875\Desktop\водосчётчик\2024\для отправки в СетиНикеля\показания на " & Date & ".pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
    

    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
    Shell ("OUTLOOK")
    Application.Wait (Now + TimeValue("0:00:10"))
    'пробуем подключиться к Outlook, если он уже открыт
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear 'Outlook закрыт, очищаем ошибку
    If objOutlookApp Is Nothing Then
        Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
    
    sTo = "@mail.ru"   
    sSubject = ""   
    sBody = ""   
    sAttachment = "C:\Users\kols0875\Desktop\водосчётчик\2024\для отправки в СетиНикеля\показания на " & Date & ".pdf"  '
    'создаем сообщение
    With objMail
        .To = sTo 'адрес получателя
        .CC = "" 'адрес для копии
        .BCC = "" 'адрес для скрытой копии
        .Subject = sSubject 'тема сообщения
        .Body = sBody 'текст сообщения
        '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.)
        .Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName
        .Display 'Send, если необходимо  отправлять без просмотра
    End With
 
    Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
    
    End Sub
 
 
 
#11
03.04.2024 10:47:52
Цитата
написал:
уберите(или закомментируйте)
сразу вылезла ошибка в строке
Код
MkDir ActiveWorkbook.Path & "\" & REPORTS_FOLDER
PAth/file access error
 
 
 
#12
03.04.2024 10:53:21
Это значит, что установлен запрет на создание папки. Как минимум, из под VBA или из Excel это делать запрещено.
Попробуйте вручную создать эту папку и запустить макрос. А по хорошему перед созданием папки надо проверять необходимость создания - вдруг папка такая уже существует. Тогда попытка создания так же может вызывать ошибку. В итоге надо как-то так:
Код
If Dir(ActiveWorkbook.Path & "\" & REPORTS_FOLDER, 16) = "" Then
   MkDir ActiveWorkbook.Path & "\" & REPORTS_FOLDER
End If

И опять же - если будет выдавать ошибку, то создайте папку вручную и запустите макрос. Если отработает - ищите причину отказа в доступе(может это сетевой ресурс и тогда лучше будет через FSO все это делать).
Изменено: Дмитрий(The_Prist) Щербаков - 03.04.2024 10:54:14
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#13
03.04.2024 10:59:47
Цитата
написал:
папка такая уже существует.
уже существует такая папка
 
 
 
#14
03.04.2024 11:01:22
Цитата
написал:
If Dir(ActiveWorkbook.Path & "\" & REPORTS_FOLDER, 16) = "" Then
  MkDir ActiveWorkbook.Path & "\" & REPORTS_FOLDER
End If
заменил на Ваш вариант - норм
 
 
 
#15
03.04.2024 11:02:41
Дальше ошибка
invalid procedure call or argument
в
Код
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                    Filename:="C:\Users\kols0875\Desktop\водосчётчик\2024\для отправки в СетиНикеля\показания на " & Date & ".pdf", _
                                    Quality:=xlQualityStandard, _
                                    IncludeDocProperties:=True, _
                                    IgnorePrintAreas:=False, _
                                    OpenAfterPublish:=False
 
 
 
#16
03.04.2024 11:03:55
видимо действительно нет принтера pdf
 
 
 
#17
03.04.2024 11:23:42
Наличие библиотеки PDF принтера можно проверить так:
Код
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") = "" Then
msgbox "Виртуальный PDF принтер не доступен!"
end if
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#18
03.04.2024 11:29:31
Цитата
написал:
не доступен
так точно.
Спасибо
 
 
 
#19
03.04.2024 12:14:57
Ох у ж этот обход ошибок  :D
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
Страницы: 1
Наверх