Home > Mobile >  Edit this code that it can open ANY .dcm file and not the specific one i selected
Edit this code that it can open ANY .dcm file and not the specific one i selected

Time:01-21

I want to open .dcm files and edit them. Then the .dcm is read and placed before the active sheet i have on my current workbook. But i need to open any .dcm file, not only one specific one.

This is my current code

Sub Makro2()
'
' Makro2 Makro
'

'
    Workbooks.OpenText Filename:= _
        "H:\ENA\N_EN_AD3\3000_Mitarbeiter\Babacan\von_Nils\C7BB2HD3IINA_NRM_X302.dcm", _
        Origin:=28592, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
        Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True
    Range("A1").Select
    Sheets("C7BB2HD3IINA_NRM_X302").Select
    Sheets("C7BB2HD3IINA_NRM_X302").Move Before:=Workbooks( _
        "ChrSet_Applikationsumgebung_inklHiAlti_X248_20221130.xlsm").Sheets(8)
End Sub

CodePudding user response:

Usual method is to use a dialog box.

Option Explicit

Sub Makro2()
    Const FOLDER = "H:\ENA\N_EN_AD3\3000_Mitarbeiter\Babacan\von_Nils\" ' initial search
    
    ' select file
    Dim filename As String
    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = FOLDER
        .Title = "Please select the file to read"
        .Filters.Add "DCM File", "*.dcm", 1
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then 'If no file is selected, abort
            MsgBox "You did not select a file", vbExclamation
            Exit Sub
        End If
        filename = .SelectedItems(1)
    End With
    
    ' open selected workbook
    Workbooks.OpenText filename:=filename, _
        Origin:=28592, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, _
        Comma:=True, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

    With ActiveWorkbook
        .Sheets(1).Move Before:=ThisWorkbook.Sheets(8)
    End With
    MsgBox "Done"

End Sub
  • Related