PDA

View Full Version : Convert all files in a folder instead individual files



wayne123
08-03-2020, 11:46 PM
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("D3:D2000")
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

wayne123
08-03-2020, 11:48 PM
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