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

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

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 18.07.2012, 13:57   #1
Naiglos
Новичок
Джуниор
 
Регистрация: 18.07.2012
Сообщений: 1
Восклицание Проблемы с использованием QueryTables (VBA for Excel 2010)

Вобщем есть макрос который должен парсить указанную папку, в которой находится определённое количество текстовых документов. Потом тянуть данные из всех этих документов на листы Excel после чего удалять текстовые документы. Все файлы имеют одинаковую структуру. А также все файлы являются доступными.
При попытке запустить макрос он на строчке .Refresh BackgroundQuery:=False выдаёт ошибку. Вопрос: Так какже мне исправить эту ошибку?
Код макроса:
Код:
Option Explicit
Sub copydata()

   Dim Filename As String
   Dim MyPath As String
   Dim fullpath As String
   MyPath = BrowseForFolder & "\"
   Filename = Dir(MyPath)
   fullpath = MyPath & Filename
   Do While Filename <> ""
       If Filename <> "." And Filename <> ".." Then
           If Filename Like "*.txt" Then
               With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fullpath, _
                    Destination:=Range("A1"))
                   .Name = Filename
                   .FieldNames = True
                   .RowNumbers = False
                   .FillAdjacentFormulas = False
                   .PreserveFormatting = True
                   .RefreshOnFileOpen = False
                   .RefreshStyle = xlInsertDeleteCells
                   .SavePassword = False
                   .SaveData = True
                   .AdjustColumnWidth = True
                   .RefreshPeriod = 0
                   .TextFilePromptOnRefresh = False
                   .TextFilePlatform = 866
                   .TextFileStartRow = 1
                   .TextFileParseType = xlFixedWidth
                   .TextFileTextQualifier = xlTextQualifierDoubleQuote
                   .TextFileConsecutiveDelimiter = False
                   .TextFileTabDelimiter = True
                   .TextFileSemicolonDelimiter = False
                   .TextFileCommaDelimiter = False
                   .TextFileSpaceDelimiter = False
                   .TextFileColumnDataTypes = Array(1, 1, 1)
                   .TextFileFixedColumnWidths = Array(1, 12)
                   .TextFileTrailingMinusNumbers = True
                   .Refresh BackgroundQuery:=False 'Вот здесь он выдаёт ошибку 1004.
               End With
                   SetAttr fullpath, vbNormal
                   Kill fullpath
           End If
       End If
       Filename = Dir
   Loop
End Sub

Function BrowseForFolder(Optional OpenAt As Variant)
'Function purpose:  To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE:  If invalid, it will open at the Desktop level

   Dim ShellApp As Object
   
   'Create a file browser window at the default folder
   Set ShellApp = CreateObject("Shell.Application"). _
       BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
   
   'Set the folder to that selected.  (On error in case cancelled)
   On Error Resume Next
       BrowseForFolder = ShellApp.self.Path
   On Error GoTo 0
   
   'Destroy the Shell Application
   Set ShellApp = Nothing
   
   'Check for invalid or non-entries and send to the Invalid error
   'handler if found
   'Valid selections can begin L: (where L is a letter) or
   '\\ (as in \\servername\sharename.  All others are invalid
   Select Case Mid(BrowseForFolder, 2, 1)
       Case Is = ":"
           If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
       Case Is = "\"
           If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
       Case Else
           GoTo Invalid
   End Select
   
   Exit Function

Invalid:
'If it was determined that the selection was invalid, set to False
   BrowseForFolder = False

End Function
Naiglos вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
VBA Word,VBA Excel решить 2 задачи fafolo4ka Фриланс 6 05.03.2012 01:15
Почему Excel 2010 выполняет поиск гораздо медленнее чем Excel 2003 Sprat Microsoft Office Excel 1 25.10.2011 05:34
VBA, Excel 2010, palette: создание палитры из более 10 цветов Pencil Microsoft Office Excel 1 14.07.2011 08:44
Скорость исполнения макроса в Excel-2010 намного ниже, чем в Excel-2003 Павел+ Microsoft Office Excel 5 29.12.2010 03:28
Изменения в VBA Excel 2010 Aent Microsoft Office Excel 0 30.12.2009 19:05