Consulting

Results 1 to 2 of 2

Thread: Convert all files in a folder instead individual files

  1. #1

    Convert all files in a folder instead individual files

    Hello All,

    Can you help me solve the following problem.

    I want to change a piece of code in the below VBA which converts .txt to excel file, but I want the code to do all files in the folder. Instead of selecting individual files.

    Code:

    'Open the file selected by the user
    Workbooks.Open fullpath

    ActiveSheet.Columns.AutoFit


    'Construct graphical analysis


    Dim ochart As Object, ochartObj As Object
    Dim countryRow As Integer, lastrow As Integer
    Set ochartObj = ActiveSheet.ChartObjects.Add(Top:=10, Left:=325, Width:=600, Height:=300)
    Set ochart = ochartObj.Chart
    ochart.ChartType = xlXYScatterSmoothNoMarkers


    Set ochart = ActiveSheet.ChartObjects(1).Chart


    ochart.SeriesCollection.Add source:=Range("B3:B2000")


    ochart.SeriesCollection(1).XValues = Range("D32000")
    ochart.SeriesCollection(1).Values = Range("B3:B2000")


    ochart.Axes(xlCategory).HasTitle = True
    ochart.Axes(xlCategory).AxisTitle.caption = "Displacement (mm)"
    ochart.Axes(xlValue).HasTitle = True
    ochart.Axes(xlValue).AxisTitle.caption = "Load (N)"
    ochart.SeriesCollection(1).HasDataLabels = False




    ochart.SeriesCollection(1).Name = ActiveSheet.Name
    ochart.Legend.Delete


    For countryRow = 2 To lastrow
    If Cells(countryRow, 4) - Cells(countryRow, 3) < 0 Then
    ochart.SeriesCollection(1).Points(countryRow - 1).MarkerStyle = xlMarkerStyleNone
    ochart.SeriesCollection(1).Points(countryRow - 1).MarkerBackgroundColor = vbRed
    ochart.SeriesCollection(1).Points(countryRow - 1).MarkerForegroundColor = vbRed
    If Cells(countryRow, 3) / Cells(countryRow, 4) > 1.15 Then
    ochart.SeriesCollection(1).Points(countryRow - 1).MarkerBackgroundColor = vbWhite
    End If
    End If
    Next countryRow


    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.Location Where:=xlLocationAsNewSheet



    'Save Copy


    Dim oFD As FileDialog
    Set oFD = Application.FileDialog(msoFileDialogSaveAs)

    End Sub

  2. #2
    Sorry I posted the wrong half of the code:

    Here what I want to change:

    Sub Time_Load_Extension_Displacement_Mac()

    Answer = MsgBox("Did you select Time,Load, Machine Extension & Displacement on the tensile machine, when you exported the data?", vbQuestion + vbYesNo + vbDefaultButton2, "Alert")


    If Answer = vbNo Then Exit Sub

    MsgBox ("Select your file")

    With Application.FileDialog(msoFileDialogFilePicker)
    'Makes sure the user can select only one file
    .AllowMultiSelect = True
    .Show

    'Store in fullpath variable
    fullpath = .SelectedItems.Item(1)
    End With

    'It's a good idea to still check if the file type selected is accurate.
    'Quit the procedure if the user didn't select the type of file we need.
    If InStr(fullpath, ".txt") = 0 Then
    Exit Sub
    End If

    'Open the file selected by the user
    Workbooks.Open fullpath

    ActiveSheet.Columns.AutoFit


    'Construct graphical analysis

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •