Гость
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Проблемы с использованием QueryTables (VBA for Excel 2010) / 7 сообщений из 7, страница 1 из 1
18.07.2012, 18:15
    #37884330
Naiglos
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с использованием QueryTables (VBA for Excel 2010)
Вобщем есть макрос который должен парсить указанную папку, в которой находится определённое количество текстовых документов. Потом тянуть данные из всех этих документов на листы Excel после чего удалять текстовые документы. Все файлы имеют одинаковую структуру. А также все файлы являются доступными.
При попытке запустить макрос он на строчке .Refresh BackgroundQuery:=False выдаёт ошибку. Вопрос: Так какже мне исправить эту ошибку?
Код макроса:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
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
...
Рейтинг: 0 / 0
18.07.2012, 18:20
    #37884333
Konst_One
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с использованием QueryTables (VBA for Excel 2010)
возможно какой то из обрабатываемых файлов в этот момент занят другим процессом.
...
Рейтинг: 0 / 0
18.07.2012, 18:29
    #37884343
Naiglos
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с использованием QueryTables (VBA for Excel 2010)
Konst_One, я более чем уверен, что файлы не заняты. Могу сказать что если вместо fullpath водить путь напрямую, то ошибки нет.
...
Рейтинг: 0 / 0
18.07.2012, 21:56
    #37884537
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с использованием QueryTables (VBA for Excel 2010)
Naiglos,
ошибку выдает на первом-же файле ? Или "терпит" до второго ?
...
Рейтинг: 0 / 0
19.07.2012, 00:57
    #37884660
Naiglos
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с использованием QueryTables (VBA for Excel 2010)
скукотища, на первом
...
Рейтинг: 0 / 0
19.07.2012, 09:25
    #37884821
Naiglos
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с использованием QueryTables (VBA for Excel 2010)
Ну что действительно никто незнает в чём дело.
...
Рейтинг: 0 / 0
27.03.2013, 17:05
    #38200879
3,50
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Проблемы с использованием QueryTables (VBA for Excel 2010)
Naiglos, неправильный путь до файла. Выведите свой путь в сообщении, сами все поймете.
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Проблемы с использованием QueryTables (VBA for Excel 2010) / 7 сообщений из 7, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]