Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Поиск и замена файла - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск и замена файла
Поиск и замена файла
pechkin Дата: Пятница, 22.07.2016, 15:02 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 206
Репутация: 27 ±
Замечаний: 0% ±

2003
Здравствуйте! Возможно ли средствами VBA реализовать следующую задумку. Есть на диске компьютера в какой-то папке файл ( например "Сводка") Такой же файл есть на внешней карте памяти. При работе с одним из этих файлов на любом из носителей в него вносятся изменения. Возможно ли и как сделать так, чтобы при закрытии рабочего файла, автоматически был найден файл с таким-же именем и происходила его замена на новый на флэшке либо диске? Спасибо!
 
Ответить
СообщениеЗдравствуйте! Возможно ли средствами VBA реализовать следующую задумку. Есть на диске компьютера в какой-то папке файл ( например "Сводка") Такой же файл есть на внешней карте памяти. При работе с одним из этих файлов на любом из носителей в него вносятся изменения. Возможно ли и как сделать так, чтобы при закрытии рабочего файла, автоматически был найден файл с таким-же именем и происходила его замена на новый на флэшке либо диске? Спасибо!

Автор - pechkin
Дата добавления - 22.07.2016 в 15:02
Саня Дата: Пятница, 22.07.2016, 15:13 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 1016
Репутация: 501 ±
Замечаний: 0% ±

XL 2010
что-то похожее. видимо.

[vba]
Код
Option Explicit

Sub CopyNewFile()
    Dim wb As Workbook: Set wb = ThisWorkbook

    If Not wb.Saved Then
        Dim msg As String
        msg = "В книге имеются не сохраненные изменения." & vbCrLf & _
              "Сохранить книгу?"
        If MsgBox(msg, vbExclamation + vbYesNo) = vbYes Then
            wb.Save
        End If
    End If

    '_______________________________________________________
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Const pZ As String = "Z:\Бюджет.xlsb"
    Dim pD As String: pD = wb.FullName

    '*******************************************************
    If pD = pZ Then
        MsgBox "Открытый ""Бюджет"" - с флешки!", vbCritical
        Exit Sub
    End If

    If Not fso.DriveExists("Z") Then    ' НЕТ ФЛЕШКИ!!!
        MsgBox "Отсутствует флешка!", vbCritical
        Exit Sub
    End If
    '*******************************************************

    If fso.FileExists(pZ) Then  ' есть на "Z"
        ' файлы
        Dim fD As Object: Set fD = fso.GetFile(pD)
        Dim fZ As Object: Set fZ = fso.GetFile(pZ)

        ' даты последнего изменения файлов
        Dim dD As Date: dD = fD.DateLastModified
        Dim dZ As Date: dZ = fZ.DateLastModified

        '#################################################################################
        If Abs(dD - dZ) < TimeSerial(0, 0, 5) Then
            MsgBox "КОПИРОВАНИЕ НЕ НУЖНО." & vbCrLf & _
                   String(50, "_") & vbCrLf & _
                   "Время последнего изменения файла:" & vbCrLf & _
                   " - на диске ""D"":   " & dD & vbCrLf & _
                   " - на диске ""Z"":   " & dZ & vbCrLf & vbCrLf & _
                   "Размер файла:" & vbCrLf & _
                   " - на диске ""D"":   " & Format(fD.Size, "#,##0 байт") & vbCrLf & _
                   " - на диске ""Z"":   " & Format(fZ.Size, "#,##0 байт"), vbInformation

        Else
            Dim fNew As Object, fOld As Object  ' файлы по новизне
            Select Case True
                Case dD > dZ
                    Set fNew = fD
                    Set fOld = fZ

                Case dZ > dD
                    Set fNew = fZ
                    Set fOld = fD
            End Select

            '--------------------------------------------------------- Обработка ---
            msg = ""
            With fNew
                msg = msg & "НОВЫЙ:" & vbCrLf
                msg = msg & .Path & vbCrLf
                msg = msg & .DateLastModified & " (" & Format(.Size, "#,##0 байт)")
            End With
            msg = msg & vbCrLf & vbCrLf

            With fOld
                msg = msg & "СТАРЫЙ:" & vbCrLf
                msg = msg & .Path & vbCrLf
                msg = msg & .DateLastModified & " (" & Format(.Size, "#,##0 байт)")
            End With
            msg = msg & vbCrLf & vbCrLf
            msg = msg & "Заменяем СТАРЫЙ файл НОВЫМ?"

            If MsgBox(msg, vbQuestion + vbOKCancel) = vbOK Then
                fNew.Copy (fOld.Path)
            Else
                MsgBox "Операция копирования отменена.", vbExclamation
            End If
        End If
        '#################################################################################

    Else    ' нет на "Z"
        If MsgBox("Файла нет на диске ""Z""." & vbNewLine & _
                  "Сохраняем копию с диска ""D""?", vbQuestion + vbOKCancel) = vbOK Then
            fso.GetFile(pD).Copy (pZ)
        End If
    End If
End Sub
[/vba]
 
Ответить
Сообщениечто-то похожее. видимо.

[vba]
Код
Option Explicit

Sub CopyNewFile()
    Dim wb As Workbook: Set wb = ThisWorkbook

    If Not wb.Saved Then
        Dim msg As String
        msg = "В книге имеются не сохраненные изменения." & vbCrLf & _
              "Сохранить книгу?"
        If MsgBox(msg, vbExclamation + vbYesNo) = vbYes Then
            wb.Save
        End If
    End If

    '_______________________________________________________
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Const pZ As String = "Z:\Бюджет.xlsb"
    Dim pD As String: pD = wb.FullName

    '*******************************************************
    If pD = pZ Then
        MsgBox "Открытый ""Бюджет"" - с флешки!", vbCritical
        Exit Sub
    End If

    If Not fso.DriveExists("Z") Then    ' НЕТ ФЛЕШКИ!!!
        MsgBox "Отсутствует флешка!", vbCritical
        Exit Sub
    End If
    '*******************************************************

    If fso.FileExists(pZ) Then  ' есть на "Z"
        ' файлы
        Dim fD As Object: Set fD = fso.GetFile(pD)
        Dim fZ As Object: Set fZ = fso.GetFile(pZ)

        ' даты последнего изменения файлов
        Dim dD As Date: dD = fD.DateLastModified
        Dim dZ As Date: dZ = fZ.DateLastModified

        '#################################################################################
        If Abs(dD - dZ) < TimeSerial(0, 0, 5) Then
            MsgBox "КОПИРОВАНИЕ НЕ НУЖНО." & vbCrLf & _
                   String(50, "_") & vbCrLf & _
                   "Время последнего изменения файла:" & vbCrLf & _
                   " - на диске ""D"":   " & dD & vbCrLf & _
                   " - на диске ""Z"":   " & dZ & vbCrLf & vbCrLf & _
                   "Размер файла:" & vbCrLf & _
                   " - на диске ""D"":   " & Format(fD.Size, "#,##0 байт") & vbCrLf & _
                   " - на диске ""Z"":   " & Format(fZ.Size, "#,##0 байт"), vbInformation

        Else
            Dim fNew As Object, fOld As Object  ' файлы по новизне
            Select Case True
                Case dD > dZ
                    Set fNew = fD
                    Set fOld = fZ

                Case dZ > dD
                    Set fNew = fZ
                    Set fOld = fD
            End Select

            '--------------------------------------------------------- Обработка ---
            msg = ""
            With fNew
                msg = msg & "НОВЫЙ:" & vbCrLf
                msg = msg & .Path & vbCrLf
                msg = msg & .DateLastModified & " (" & Format(.Size, "#,##0 байт)")
            End With
            msg = msg & vbCrLf & vbCrLf

            With fOld
                msg = msg & "СТАРЫЙ:" & vbCrLf
                msg = msg & .Path & vbCrLf
                msg = msg & .DateLastModified & " (" & Format(.Size, "#,##0 байт)")
            End With
            msg = msg & vbCrLf & vbCrLf
            msg = msg & "Заменяем СТАРЫЙ файл НОВЫМ?"

            If MsgBox(msg, vbQuestion + vbOKCancel) = vbOK Then
                fNew.Copy (fOld.Path)
            Else
                MsgBox "Операция копирования отменена.", vbExclamation
            End If
        End If
        '#################################################################################

    Else    ' нет на "Z"
        If MsgBox("Файла нет на диске ""Z""." & vbNewLine & _
                  "Сохраняем копию с диска ""D""?", vbQuestion + vbOKCancel) = vbOK Then
            fso.GetFile(pD).Copy (pZ)
        End If
    End If
End Sub
[/vba]

Автор - Саня
Дата добавления - 22.07.2016 в 15:13
_Boroda_ Дата: Пятница, 22.07.2016, 15:19 | Сообщение № 3
Группа: Модераторы
Ранг: Экселист
Сообщений: 9365
Репутация: 3939 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
pechkin, Вам ведь удочка нужна, а не рыба, правильно? Если да, то вот https://msdn.microsoft.com/ru-ru/library/zfk1t850.aspx


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщениеpechkin, Вам ведь удочка нужна, а не рыба, правильно? Если да, то вот https://msdn.microsoft.com/ru-ru/library/zfk1t850.aspx

Автор - _Boroda_
Дата добавления - 22.07.2016 в 15:19
pechkin Дата: Пятница, 22.07.2016, 15:49 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 206
Репутация: 27 ±
Замечаний: 0% ±

2003
Спасибо! Boroda, к сожалению почему-то уже не в первый раз у меня ссылки на Microsoft не работают :( Толком не разбирался почему Может санкции???
 
Ответить
СообщениеСпасибо! Boroda, к сожалению почему-то уже не в первый раз у меня ссылки на Microsoft не работают :( Толком не разбирался почему Может санкции???

Автор - pechkin
Дата добавления - 22.07.2016 в 15:49
_Boroda_ Дата: Пятница, 22.07.2016, 16:11 | Сообщение № 5
Группа: Модераторы
Ранг: Экселист
Сообщений: 9365
Репутация: 3939 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
у меня ссылки на Microsoft не работают
А вот у Майкрософта https://support.microsoft.com/ru-ru/kb/981149 как раз по поводу неработающих ссылок :D :D :D

Там правда не совсем про это, но похоже. Они говорят, что можно попробовать установить Internet Explorer по умолчанию. Дескать
Цитата
Информация в реестре не удаляется после деинсталляции постороннего браузера обозначенного как предустановленный, в основном, это происходит когда деинсталлируется Google Chrom


А с других машин тоже не открывается?


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
у меня ссылки на Microsoft не работают
А вот у Майкрософта https://support.microsoft.com/ru-ru/kb/981149 как раз по поводу неработающих ссылок :D :D :D

Там правда не совсем про это, но похоже. Они говорят, что можно попробовать установить Internet Explorer по умолчанию. Дескать
Цитата
Информация в реестре не удаляется после деинсталляции постороннего браузера обозначенного как предустановленный, в основном, это происходит когда деинсталлируется Google Chrom


А с других машин тоже не открывается?

Автор - _Boroda_
Дата добавления - 22.07.2016 в 16:11
pechkin Дата: Пятница, 22.07.2016, 16:26 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 206
Репутация: 27 ±
Замечаний: 0% ±

2003
С других машин не пробовал. Моя работа с Интернетом никак не связана. При случае проверю. Спасибо!
 
Ответить
СообщениеС других машин не пробовал. Моя работа с Интернетом никак не связана. При случае проверю. Спасибо!

Автор - pechkin
Дата добавления - 22.07.2016 в 16:26
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Поиск и замена файла
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!