Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.06.2013, 13:43   #1
Kek
Пользователь
 
Регистрация: 20.06.2011
Сообщений: 54
По умолчанию оптимизировать макрос

Был откопан файл с макросом, который скачивает файлы при нажатии на обновить.
1) он скачивает в виде первого столбца (даты). необходимо в виде второго столбца (отдела).
2) что дописать чтобы запускался автоматически?
Код:
Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                                   (ByVal pCaller As Long, ByVal szURL As String, _
                                    ByVal szFileName As String, ByVal dwReserved As Long, _
                                    ByVal lpfnCB As Long) As Long
                                    
Sub ostdownloader()
    vPath = ActiveWorkbook.Path
    Range("2:65535").Clear
    mag = Format(Sheets("mag").Cells(Sheets("mag").Cells(1, 1).Value + 1, 1).Value, "000")
    mag_id = Sheets("mag").Cells(Sheets("mag").Cells(1, 1).Value + 1, 2).Value
'   msgbox mag & " - " & mag_id
    Set Conn = CreateObject("ADODB.Connection")
        Conn.Open "Provider=SQLOLEDB;User ID=;Password=@;Initial Catalog=OST;Data Source=PSTOR" & mag
        Conn.CommandTimeout = 0
    Set rstADO = CreateObject("ADODB.Recordset")
    dat = Format(Cells(1, 1), "yyyy-mm-dd") '  " & dat & "
    Sql$ = "select DISTINCT LOG_NUMBER, DEPARTMENT_ID from Rupture where (DATE_F > CONVERT(DATETIME, '" & dat & " 00:00:00', 102)) AND (DATE_F < CONVERT(DATETIME, '" & dat & " 23:59:59', 102)) "
    Set rstADO = Conn.Execute(Sql)
    Cells(2, 1).CopyFromRecordset rstADO
    Range("2:65535").NumberFormat = "0"
    Conn.Close
    rrow = 2
    Do While Cells(rrow, 1).Value <> ""
        fName = Cells(rrow, 1).Value
        link = "http://prs
Sheets("rayon").Cells(Cells(rrow, 2).Value, 2).Value & "&P_RLV=" & fName & "&rs%3aCommand=Render&rs%3AFormat=EXCEL"
        Cells(rrow, 3).Value = link
'       msgbox vPath & "\" & fName & ".xls"
         DownloadFile link, vPath & "\" & fName & ".xls"
         rrow = rrow + 1
    Loop
End Sub


Function DownloadFile(FromPathName, ToPathName) As Boolean
    DownloadFile = URLDownloadToFile(0, FromPathName, ToPathName, 0, 0) = 0
End Function
Kek вне форума Ответить с цитированием
Старый 28.06.2013, 16:15   #2
Kek
Пользователь
 
Регистрация: 20.06.2011
Сообщений: 54
По умолчанию

могу добавить файл, если что то есть непонятное
Kek вне форума Ответить с цитированием
Старый 29.06.2013, 17:54   #3
Kek
Пользователь
 
Регистрация: 20.06.2011
Сообщений: 54
По умолчанию

удаляйте тему
спасибо за помощь
Kek вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Возможно ли оптимизировать макрос Vadim39 Microsoft Office Word 9 21.05.2013 09:35
Оптимизировать код strannick Microsoft Office Excel 9 14.11.2012 00:59
Оптимизировать программу phenix Помощь студентам 1 15.12.2010 01:53
Помогите оптимизировать макрос kipish_lp Microsoft Office Excel 20 27.07.2010 10:48
Оптимизировать код NeiL Помощь студентам 2 21.02.2008 08:57