Открытие или перенос данных из dbf файла в Excel макросом - VB

Узнай цену своей работы

Формулировка задачи:

Ребята, начну с того что я только учусь и с этим никогда не сталкивался :-)
У меня задачка такого рода: есть папка с файлами dbf. Каждый день она пополняется новой партией файлов из которых мне надо только 3 определённых файла. На работе делал так - Сортировал за возрастанием по дате, потом выберал нужные файли и открывал екселем, данные копировал в листы другой книги, где макрос делал выборку нужной информации и збивал в кучу.
Так как этот процес нужно делать по пару раз в день, хотелось бы его автоматизировать (бывають промахи - человеческий фактор). Помогите пожалуйста, с кодом макроса. Необезательно что бы он был крутой - простенький. Дальше я бы уже разобрался...
Папку с файлами прикрепил.

Решение задачи: «Открытие или перенос данных из dbf файла в Excel макросом»

textual
Листинг программы
<font color="blue">Dim</font> i
<font color="blue">Dim</font> FL_n
<font color="blue">Dim</font> FL_d
<font color="blue">Dim</font> FL
<font color="blue">Dim</font> M()
<font color="blue">Sub</font> test()
<font color="blue">ReDim</font> M(<font color="darkblue"><b>1</b></font>, <font color="darkblue"><b>0</b></font>)
<font color="blue">Dim</font> Folder <font color="blue">As</font> <font color="blue">String</font>
<font color="blue">Dim</font> FSO <font color="blue">As</font> <font color="blue">Object</font>
<font color="blue">Dim</font> S
Ns = Ns + <font color="darkblue"><b>1</b></font>
  Application.ScreenUpdating = True
<font color="#00AA00">' ОЧИСТИТЬ</font>
 <font color="blue">Set</font> workWb = ActiveWorkbook
  <font color="blue">With</font> Application.FileDialog(msoFileDialogFolderPicker)
    .Title = <font color="teal">"Выберите папку, файлы в которой нужно обработать"</font>
    .ButtonName = <font color="teal">"Выбрать"</font>
    .AllowMultiSelect = True
    <font color="blue">If</font> .Show <font color="blue">Then</font> Folder = .SelectedItems(<font color="darkblue"><b>1</b></font>) <font color="blue">Else</font> <font color="blue">Exit</font> <font color="blue">Sub</font>
  <font color="blue">End</font> <font color="blue">With</font>
  Application.StatusBar = <font color="teal">"Идёт обработка документов"</font>
     <font color="blue">Set</font> FSO = CreateObject(<font color="teal">"Scripting.FileSystemObject"</font>)
   Search FSO.GetFolder(Folder)
   
   <font color="blue">For</font> i = <font color="darkblue"><b>0</b></font> <font color="blue">To</font> <font color="darkblue"><b>2</b></font>
   <font color="#00AA00">''''' Здесь будет твой код открытия и обработки. Мне пока некогда</font>
   <font color="blue">Next</font> i
<font color="blue">End</font> <font color="blue">Sub</font>

<font color="blue">Sub</font> Search(Fold <font color="blue">As</font> <font color="blue">Object</font>)
<font color="blue">Dim</font> J
<font color="blue">Dim</font> D
<font color="blue">Dim</font> R
<font color="blue">Dim</font> Tn, Tf
   <font color="blue">For</font> <font color="blue">Each</font> Fil <font color="blue">In</font> Fold.Files
    <font color="blue">If</font> StrComp(Right$(Fil.<font color="blue">Name</font>, <font color="darkblue"><b>4</b></font>), <font color="teal">".001"</font>, vbTextCompare) = <font color="darkblue"><b>0</b></font> <font color="blue">Then</font>
        <font color="blue">ReDim</font> Preserve M(<font color="darkblue"><b>1</b></font>, UBound(M, <font color="darkblue"><b>2</b></font>) + <font color="darkblue"><b>1</b></font>)
        D = FileDateTime(Fil)
        Debug.<font color="blue">Print</font> Format(D, <font color="teal">"mm"</font>)
        Debug.<font color="blue">Print</font> Format(D, <font color="teal">"dd"</font>)
         J = CDbl(Year(D) & Format(D, <font color="teal">"mm"</font>) & Format(D, <font color="teal">"dd"</font>) _
         & Format(D, <font color="teal">"hh"</font>) & Format(D, <font color="teal">"nn"</font>) & Format(D, <font color="teal">"ss"</font>))
                  
            M(<font color="darkblue"><b>0</b></font>, UBound(M, <font color="darkblue"><b>2</b></font>)) = Fil
            M(<font color="darkblue"><b>1</b></font>, UBound(M, <font color="darkblue"><b>2</b></font>)) = J
                <font color="blue">For</font> R = UBound(M, <font color="darkblue"><b>2</b></font>) <font color="blue">To</font> <font color="darkblue"><b>1</b></font> <font color="blue">Step</font> -<font color="darkblue"><b>1</b></font>
                    <font color="blue">If</font> M(<font color="darkblue"><b>1</b></font>, R) > M(<font color="darkblue"><b>1</b></font>, R - <font color="darkblue"><b>1</b></font>) <font color="blue">Then</font>
                        Tf = M(<font color="darkblue"><b>0</b></font>, R): Tn = M(<font color="darkblue"><b>1</b></font>, R)
                        M(<font color="darkblue"><b>0</b></font>, R) = M(<font color="darkblue"><b>0</b></font>, R - <font color="darkblue"><b>1</b></font>): M(<font color="darkblue"><b>1</b></font>, R) = M(<font color="darkblue"><b>1</b></font>, R - <font color="darkblue"><b>1</b></font>)
                        M(<font color="darkblue"><b>0</b></font>, R - <font color="darkblue"><b>1</b></font>) = Tf:  M(<font color="darkblue"><b>1</b></font>, R - <font color="darkblue"><b>1</b></font>) = Tn
                    <font color="blue">End</font> <font color="blue">If</font>
                <font color="blue">Next</font> R
    <font color="blue">End</font> <font color="blue">If</font>
  <font color="blue">Next</font> Fil

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

7   голосов , оценка 4 из 5
Похожие ответы