Импорт текстового файла в Excel попадает во второй запуск кода - PullRequest
Новая
       6

Импорт текстового файла в Excel попадает во второй запуск кода

0 голосов
/ 23 января 2019

Я пытаюсь открыть PowerPoint, найти новый текстовый файл в папке, открыть текстовый файл в Excel, отформатировать текстовый файл, а затем сохранить файл в формате xlsx.Затем этот окончательный документ будет обновлен в презентации PowerPoint.

Проблема, с которой я столкнулся, заключается в том, что код будет запущен один раз и будет работать так, как должен.Затем на следующей итерации PowerPoint вылетает.Похоже, что код сохраняет связь, чтобы преуспеть, и я не могу понять, как его разорвать при заключении кода.Есть идеи? 

Sub ImportFormatIN3()


    Dim MyPath As String
    Dim TargetFolder As String
    Dim MyFile As String
    Dim LatestFile As String
    Dim latestDate As Date
    Dim LMD As Date

    'Defined path to reports
    MyPath = "R:\filelocation\"
    TargetFolder = "C:\midfilelocation\FinalIN3.txt"

    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    MyFile = Dir(MyPath & "*.txt")
    If Len(MyFile) = 0 Then
      Exit Sub
    End If

    'Find the newest file in the mypath
    Do While Len(MyFile) > 0
        LMD = FileDateTime(MyPath & MyFile)
        If LMD > latestDate Then
            LatestFile = MyFile
            latestDate = LMD
        End If
        MyFile = Dir
    Loop

    FileCopy MyPath & LatestFile, TargetFolder

    Dim xlApp As Excel.Application
    Set xlApp = New Excel.Application
    xlApp.Workbooks.Add
    xlApp.Visible = True


    'On Error Resume Next
    With xlApp.ActiveSheet.QueryTables.Add(Connection:="TEXT;midfilelocation\FinalIN3.txt", Destination:=Range("A1"))

        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(4, 10, 10, 9, 18, 15, 23, 32, 12, 5, 7, 13, 9, 6)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Rows("1:9").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").Select
    Selection.Delete Shift:=xlToLeft
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Range("M:M,N:N").Select
    Range("N1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Range("F20").Select


     Columns("D").EntireColumn.Delete
     Columns("H").EntireColumn.Delete
     Columns("I").EntireColumn.Delete
     Columns("G").EntireColumn.Delete
     Columns("C").EntireColumn.Delete
     Columns("A").EntireColumn.Delete


     Columns("A").ColumnWidth = 25
     Columns("B").ColumnWidth = 25
     Columns("C").ColumnWidth = 30
     Columns("D").ColumnWidth = 60
     Columns("E").ColumnWidth = 15


     Range("A1:E1").EntireRow.Insert
     Range("A1:E1").Merge
     Range("A:E").HorizontalAlignment = xlCenter
     Range("A:E").Font.Size = 15
     Range("A1").Font.Size = 30
     Range("A1").Value = "IN3 Dispatch as of " & latestDate


    Dim KillConnects As Long
    With ActiveWorkbook
        For KillConnects = .Connections.Count To 1 Step -1
            .Connections(KillConnects).Delete
        Next KillConnects
    End With

    ActiveWorkbook.SaveAs FileName:="C:\finalfilelocation\FinalIN3Document.xlsx", AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges

    ActiveWorkbook.Close

    xlApp.Workbooks.Close

 End Sub

Ответы [ 2 ]

0 голосов
/ 30 января 2019

Я заставил его работать, добавив xlAPP перед большей частью кода (см. Ниже). Еще раз спасибо за вашу помощь в этом всем. Что мне нужно сделать, чтобы пометить это как решенное? 

With xlApp.ActiveSheet.QueryTables.Add(Connection:="TEXT;C:filepath\begin.txt", Destination:=xlApp.Cells(1, 1))

        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileFixedColumnWidths = Array(4, 10, 10, 9, 18, 15, 23, 32, 12, 5, 7, 13, 9, 6)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    xlApp.Rows("1:9").Select
    xlApp.Selection.Delete Shift:=xlUp
    xlApp.Columns("A:A").Select
    xlApp.Selection.Delete Shift:=xlToLeft
    xlApp.Rows("2:2").Select
    xlApp.Selection.Delete Shift:=xlUp
    xlApp.Range("M:M,N:N").Select
    xlApp.Range("N1").Activate
    xlApp.Selection.Delete Shift:=xlToLeft
    xlApp.Columns("K:K").Select
    xlApp.Selection.Delete Shift:=xlToLeft
    xlApp.Range("F20").Select


     xlApp.Columns("D").EntireColumn.Delete
     xlApp.Columns("H").EntireColumn.Delete
     xlApp.Columns("I").EntireColumn.Delete
     xlApp.Columns("G").EntireColumn.Delete
     xlApp.Columns("C").EntireColumn.Delete
     xlApp.Columns("A").EntireColumn.Delete


     xlApp.Columns("A").ColumnWidth = 25
     xlApp.Columns("B").ColumnWidth = 25
     xlApp.Columns("C").ColumnWidth = 30
     xlApp.Columns("D").ColumnWidth = 60
     xlApp.Columns("E").ColumnWidth = 15


     xlApp.Range("A1:E1").EntireRow.Insert
     xlApp.Range("A1:E1").Merge
     xlApp.Range("A:E").HorizontalAlignment = xlCenter
     xlApp.Range("A:E").Font.Size = 15
     xlApp.Range("A1").Font.Size = 30
     xlApp.Range("A1").Value = "IN3 Dispatch as of " & latestDate


    xlApp.DisplayAlerts = False

    xlApp.ActiveWorkbook.SaveAs FileName:="C:\filepath\end.xlsx", AccessMode:=xlExclusive, ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges

    xlApp.ActiveWorkbook.Close

    xlApp.Workbooks.Close


   xlApp.Quit
   Excel.Application.Quit
0 голосов
/ 25 января 2019

Вам нужно очистить переменную Excel, установив ее в ничто после того, как она была закрыта.Кроме того, добавьте строку xlApp.DisplayAlerts = False.

после 

    xlApp.DisplayAlerts = False

    xlApp.ActiveWorkbook.SaveAs Filename:="C:\finalfilelocation\FinalIN3Document.xlsx", 
       AccessMode:=xlExclusive, 
       ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges

    xlApp.ActiveWorkbook.Close

    xlApp.Workbooks.Close

    xlApp.Quit

поставьте следующее: 

Set xlApp = Nothing

Это должно решить проблему.

...