powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Сохранить макросом в Exel последовательно много открытых txt
25 сообщений из 25, страница 1 из 1
Сохранить макросом в Exel последовательно много открытых txt
    #33603152
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Назрела такая задача...
Нужно теперь сохранить много открытых в Exel файлов *.txt в *.xls

Код: plaintext
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.
Dim Myfile
Dim myPath As String
Myfile = Dir("C:\tdk\Work\*.txt")
        Do While Myfile <> ""
        myPath = "C:\tdk\Work\" & Myfile
            Workbooks.OpenText Filename:=myPath, _
                Origin:= 1251 , StartRow _
        := 1 , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), _
        Array( 3 ,  1 ), Array( 4 ,  1 ), Array( 5 ,  1 ), Array( 6 ,  1 )), TrailingMinusNumbers:=True
    
    Columns("B:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:B33").Select
    Selection.Copy
    ChDir "C:\tdk\Work"
    Workbooks.Open Filename:="C:\tdk\Work\RTK.xls", Origin:=xlWindows
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    
    ActiveWorkbook.SaveAs Filename:="C:\tdk\Work\*.xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
    ActiveWindow.Close

Выдает ошибку на
Код: plaintext
1.
2.
3.
ActiveWorkbook.SaveAs Filename:="C:\tdk\Work\*.xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
1004
В общем? имя файла xls должно совпадать с именем файла в txt.
То есть, был 1.txt - сохранился как 1.xls.

Пожалуйста, помогите.
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33603184
melamory
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
мы делали так
сначала:
Workbooks.OpenText Filename:= path1 & ".txt" ...

потом
ActiveWorkbook.SaveAs Filename:= path1 & ".xls" ...
где path1 имя без расширения
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33603211
Tин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вау!
Все получилось!
Большущее СПАСИБО!

Вот так все работает отлично!
Код: plaintext
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.
Dim Myf
Dim myP As String
Dim Myfile
Dim myPath As String
Myfile = Dir("C:\tdk\Work\*.txt")
        Do While Myfile <> ""
        myPath = "C:\tdk\Work\" & Myfile
            Workbooks.OpenText Filename:=myPath, _
                Origin:= 1251 , StartRow _
        := 1 , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), _
        Array( 3 ,  1 ), Array( 4 ,  1 ), Array( 5 ,  1 ), Array( 6 ,  1 )), TrailingMinusNumbers:=True
    
    Columns("B:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:B33").Select
    Selection.Copy
    ChDir "C:\tdk\Work"
    Workbooks.Open Filename:="C:\tdk\Work\RTK.xls", Origin:=xlWindows
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    
    
    ActiveWorkbook.SaveAs Filename:=myPath & ".xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
    ActiveWindow.Close

            Myfile = Dir
            
        
Loop


End Sub
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605255
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
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.
Sub F()
    Dim xlAp As New Excel.Application
    Dim xlWb As Excel.Workbook
    Dim rng As Range
    Dim Myf
    Dim myP As String
    Dim Myfile
    Dim myPath As String, myName As String
    ChDir "C:\tdk\Work"
    myName = "RTK.xls"
    Workbooks.Open Filename:="C:\tdk\Work\" & myName, Origin:=xlWindows
    Myfile = Dir("C:\tdk\Work\*.txt")
    Do While Myfile <> ""
        Workbooks(myName).Sheets( 1 ).Cells.Clear
        myPath = "C:\tdk\Work\" & Myfile
        Set xlWb = xlAp.Workbooks.OpenText(Filename:=myPath, _
            Origin:= 1251 , StartRow _
            := 1 , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
            , Space:=False, Other:=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), _
            Array( 3 ,  1 ), Array( 4 ,  1 ), Array( 5 ,  1 ), Array( 6 ,  1 )), TrailingMinusNumbers:=True)
        xlWb.Sheets( 1 ).Columns("B:E").Delete Shift:=xlToLeft
        xlWb.Sheets( 1 ).Range("A1:B33").Copy
        Workbooks(myName).Sheets( 1 ).Paste Workbooks(myName).Sheets( 1 ).Range("A1").Select
        Application.CutCopyMode = False
        
        
        Workbooks(myName).SaveAs Filename:="C:\tdk\Work\" & xlWb.Name, FileFormat:=xlNormal _
            , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
            CreateBackup:=False
        myName = xlWb.Name
        Myfile = Dir
    Loop
    Workbooks(myName).Close

End Sub
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605321
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Огромное СПАСИБО тебе в очередной раз за помощь!!!

Мне конечно не все тут надо, поправлю счас :))
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605335
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ТинОгромное СПАСИБО тебе в очередной раз за помощь!!!

Мне конечно не все тут надо, поправлю счас :))
пл
з
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605374
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Могу я еще один вопросик задать?

Вот здесь:
Код: plaintext
1.
2.
3.
4.
5.
Set xlWb = xlAp.Workbooks.OpenText(Filename:=myPath, _
            Origin:= 1251 , StartRow _
            := 1 , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
            , Space:=False, Other:=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), _
            Array( 3 ,  1 ), Array( 4 ,  1 ), Array( 5 ,  1 ), Array( 6 ,  1 )), TrailingMinusNumbers:=True)  
открываем *.txt в Exel

Код: plaintext
1.
xlWb.Sheets( 1 ).Columns("B:E").Delete Shift:=xlToLeft
        xlWb.Sheets( 1 ).Range("A1:B33").Copy 
удаление ненужных столбцов

Код: plaintext
Workbooks(myName).Sheets( 1 ).Paste Workbooks(myName).Sheets( 1 ).Range("A1").Select
все копируется в книгу RTK.xls
Правильно?
xlWb.Sheets(1) что дает?
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605441
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ТинМогу я еще один вопросик задать?

Вот здесь:
Код: plaintext
1.
2.
3.
4.
5.
Set xlWb = xlAp.Workbooks.OpenText(Filename:=myPath, _
            Origin:= 1251 , StartRow _
            := 1 , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
            , Space:=False, Other:=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), _
            Array( 3 ,  1 ), Array( 4 ,  1 ), Array( 5 ,  1 ), Array( 6 ,  1 )), TrailingMinusNumbers:=True)  
открываем *.txt в Exel

Код: plaintext
1.
xlWb.Sheets( 1 ).Columns("B:E").Delete Shift:=xlToLeft
        xlWb.Sheets( 1 ).Range("A1:B33").Copy 
удаление ненужных столбцов

Код: plaintext
Workbooks(myName).Sheets( 1 ).Paste Workbooks(myName).Sheets( 1 ).Range("A1").Select
все копируется в книгу RTK.xls
Правильно?
xlWb.Sheets(1) что дает?

Sheets(1) - это первый лист в книге
если ты хочешь добраться до ячейки(ну что бы делать разные манипуляции)
нужно прописать имя книги в колекции excel
имя листа в коллекции книги
имя ячейки в колекции листа
вообщем если написать
xlWb.range(...) - будет ошибка
в данном случае xlWb мы оператором set присвоили открываемый объект т.е. книгу
соответственно при дальнейшей обработки мы ссылаемся на короткое имя и имя листа с ячейкой.
ну где-то так

...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605530
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Угу, понял

Вот это не поняла:
Код: plaintext
1.
Workbooks(myName).Sheets( 1 ).Paste Workbooks(myName).Sheets( 1 ).Range("A2").Select
        Application.CutCopyMode = False
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605560
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Еще ругается вот здесь
Код: plaintext
1.
2.
Set xlWb = xlAp.Workbooks[color=red].OpenText[/color](Filename:=myPath, _
                Origin:= 1251 , StartRow:= 1 , DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
Expected Function or variable
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605596
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ТинУгу, понял

Вот это не поняла:
Код: plaintext
1.
Workbooks(myName).Sheets( 1 ).Paste Workbooks(myName).Sheets( 1 ).Range("A2").Select
        Application.CutCopyMode = False

это тоже самое что и
Код: plaintext
Workbooks(myName).Sheets( 1 ).Paste Destination:=Workbooks(myName).Sheets( 1 ).Range("A2").Select
просто не обязательно писать Destination:=
а Тин
Код: plaintext
Application.CutCopyMode = False

очистка буфера обмена
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605616
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
выложи хоть один свой txt что бы можно было проверить
или на email брось
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605644
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
авторвыложи хоть один свой txt что бы можно было проверить
или на email брось

Не могу :( там секретная информация

Данные в столбцах с разделителями tab.

Столбцов восемь.

на .OpenText ругается
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605777
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вообще, задача такова:

Есть много однотипных txt.
Нужно открыть 1.txt в Exel.
Произвести на листе несколько операций.
Скопировать диапазон оставшихся данных.
Открыть шаблон.xlt.
Вставить в него эти данные.
Сохранить под именем 1.xls и закрыть.
Закрыть 1.txt без изменений.

Открыть 2.txt и проделать с ним то же самое.
И так далее, пока файлы txt не кончатся.

С твоей помощью все это получается, НО сохраняется как *.txt.xls
Это и нужно исправить.
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605808
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
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.
Dim Myf
Dim myP As String
Dim Myfile
Dim myPath As String
Myfile = Dir("C:\tdk\Work\*.txt")
        Do While Myfile <> ""
        myPath = "C:\tdk\Work\" & Myfile
            Workbooks.OpenText Filename:=myPath, _
                Origin:= 1251 , StartRow _
        := 1 , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), _
        Array( 3 ,  1 ), Array( 4 ,  1 ), Array( 5 ,  1 ), Array( 6 ,  1 )), TrailingMinusNumbers:=True
    
    Columns("B:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:B33").Select
    Selection.Copy
    ChDir "C:\tdk\Work"
    Workbooks.Open Filename:="C:\tdk\Work\RTK.xls", Origin:=xlWindows
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    
    myPath  = "C:\tdk\Work\" & ActiveWorkbook.Name
    ActiveWorkbook.SaveAs Filename:=myPath , FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
    ActiveWindow.Close

            Myfile = Dir
            
        
Loop


End Sub
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605895
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо!

В строке:
Код: plaintext
1.
myPath  = "C:\tdk\Work\" & ActiveWorkbook.Name
в соответствие ставится имя шаблона так как он в этот момент активный, а надо имя текстового файла
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605968
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
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.
Dim Myf
Dim myP As String
Dim Myfile
Dim myPath As String
Myfile = Dir("C:\tdk\Work\*.txt")
        Do While Myfile <> ""
        myPath = "C:\tdk\Work\" & Myfile
            Workbooks.OpenText Filename:=myPath, _
                Origin:= 1251 , StartRow _
        := 1 , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), _
        Array( 3 ,  1 ), Array( 4 ,  1 ), Array( 5 ,  1 ), Array( 6 ,  1 )), TrailingMinusNumbers:=True

    myPath  = "C:\tdk\Work\" & ActiveWorkbook.Name    
    Columns("B:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:B33").Select
    Selection.Copy
    ChDir "C:\tdk\Work"
    Workbooks.Open Filename:="C:\tdk\Work\RTK.xls", Origin:=xlWindows
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:=myPath , FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
    ActiveWindow.Close

            Myfile = Dir
            
        
Loop


End Sub
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33605997
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Ругается на
[SRC vba][/ActiveWorkbook.SaveAs Filename:=myPath, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=FalseSRC]
Сохранить файл под именем, совпадающим с именем открытого документа, невозможно
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33606021
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
попробуй так
Код: plaintext
myPath  = "C:\tdk\Work\" & ActiveWorkbook.Name & ".xls"
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33606033
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
:)
Чего имели, к тому и пришли...

Опять сохраняет как *.txt.xls
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33606059
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
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.
Dim Myf
Dim myP As String
Dim Myfile
Dim myPath As String
dim a() as String
Myfile = Dir("C:\tdk\Work\*.txt")
        Do While Myfile <> ""
        myPath = "C:\tdk\Work\" & Myfile
            Workbooks.OpenText Filename:=myPath, _
                Origin:= 1251 , StartRow _
        := 1 , DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array( 1 ,  1 ), Array( 2 ,  1 ), _
        Array( 3 ,  1 ), Array( 4 ,  1 ), Array( 5 ,  1 ), Array( 6 ,  1 )), TrailingMinusNumbers:=True
    a = split(ActiveWorkbook.Name,".")
    myPath  = "C:\tdk\Work\" & a( 0 ) & ".xls"    
    Columns("B:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1:B33").Select
    Selection.Copy
    ChDir "C:\tdk\Work"
    Workbooks.Open Filename:="C:\tdk\Work\RTK.xls", Origin:=xlWindows
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:=myPath , FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    ActiveWindow.Close
    ActiveWindow.Close

            Myfile = Dir
            
        
Loop


End Sub
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33606071
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
:))
Ну что тут скажешь...
ГЕНИАЛЬНО!!!

ОГРОМНОЕ СПАСИБО за такую супер-помощь!!!
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33606092
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
а этот вариант тынц предпаолагался быть значительно лутше
без мельканий на экране да и открывается в скрытом виде быстрее
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33606107
Тин
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
А "тынц" я тоже применю :) только к другим операциям.

Моя глубочайшая признательность!
...
Рейтинг: 0 / 0
Сохранить макросом в Exel последовательно много открытых txt
    #33850141
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Вот нашел пример, пример в статье.

Название статьи: Read a Text File with VBA, And Write the Text to Excel

Задача:

авторI need to write a text file into one row of my Excel spreadsheet, cell by cell, 20 characters at a time. It's urgent. Can you help?
...
Рейтинг: 0 / 0
25 сообщений из 25, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Сохранить макросом в Exel последовательно много открытых txt
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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