Tonchik133 (Все сообщения пользователя)

Копирование данных из .txt в excell

Пользователь

Сообщений: 3 Регистрация: 07.04.2020

13.09.2023 15:56:31

подскажите пожалуйста с чем может быть связана проблема. При использовании вышеуказанного макроса текст из файла .txt не выводится на кириллице и возможно ли доработать макрос таким образом, что выбирать несколько файлов за 1 раз.

Цитата

написал:
Sub Макрос1()Dim r As Range On Error Resume Next Set r = Application.InputBox("Выберите первую ячейку для вставки", , _ Selection.Cells(1).Address, Type:=8).Cells(1) If Err Then Exit Sub With ActiveSheet.QueryTables.Add(Connection:="TEXT;", Destination:=r) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = True .TextFilePlatform = 1251 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False .Delete End WithEnd Sub

Пример текстового файла во вложении.

Перейти

Перемещение файлов по данным из ячейки

Tonchik133

Пользователь

Сообщений: 3 Регистрация: 07.04.2020

07.04.2020 21:23:05

Удалось решить вопрос самостоятельно

Код

 Const strRootFolder As String = "C:\Users\Антон\Desktop\Акты передачи дел\"
     
    Dim strYear As String, strMonth As String
    Dim y As Long
     
    strYear = Format(Date, "yyyy")
    strMonth = Format(Date, "dd.mm.yyyy")

     
    If Dir(strRootFolder & strYear, vbDirectory) = "" Then
        MkDir strRootFolder & strYear
    End If
     
    If Dir(strRootFolder & strYear & "\" & strMonth, vbDirectory) = "" Then
        MkDir strRootFolder & strYear & "\" & strMonth
    End If

ThisWorkbook.Worksheets("Акт приема-передачи").Copy
       iFullName = strRootFolder & strYear & "\" & strMonth & "\" & Date & " - " & Client & ".xlsx"
        ActiveWorkbook.SaveAs Filename:=iFullName
       ActiveWorkbook.Close

Перейти

Перемещение файлов по данным из ячейки

Tonchik133

Пользователь

Сообщений: 3 Регистрация: 07.04.2020

07.04.2020 12:59:28

Добрый день.

Просьба помочь в решении проблемы. Имеется общий файл с данными и через него формируются отдельные файлы, которые сохраняются только в заданной папке. К сожалению, никак не удается настроить перемещение файлов в созданную папку. Папка создается по принципу текущей даты

Это макрос по созданию отдельных файлов

Код

       ThisWorkbook.Worksheets("Акт приема-передачи").Copy
        iFullName = ThisWorkbook.path & "\тест папки\2020\" & Date &".xlsx"
        ActiveWorkbook.SaveAs Filename:=iFullName
       ActiveWorkbook.Close

А это макрос по созданию папок

Код

    Const strRootFolder As String = "C:\Users\Àíòîí\Desktop\êîíôèäåíöèàëüíûå äåëà\òåñò ïàïêè\"
     
    Dim strYear As String, strMonth As String
    Dim i As Long
     
    strYear = Format(Date, "yyyy")
    strMonth = Format(Date, "dd.mm.yyyy")

     
    If Dir(strRootFolder & strYear, vbDirectory) = "" Then
        MkDir strRootFolder & strYear
    End If
     
    If Dir(strRootFolder & strYear & "\" & strMonth, vbDirectory) = "" Then
        MkDir strRootFolder & strYear & "\" & strMonth
    End If

Изменено: Tonchik133 - 07.04.2020 16:16:15

Перейти