wwrightchess
New Member
- Joined
- Apr 20, 2022
- Messages
- 29
- Office Version
- 365
- Platform
- MacOS
I am trying to take columns of data from a spreadsheet and save it as a text file.
Saving as an excel workbook works fine. I have tried other text formats and have the same problem.
Sub extract_shape()
'
' extract_shape Macro
'
'
Dim myPath As String
Dim myName As String
Dim fullname As String
Dim i As Long
Dim filelist() As Variant
myPath = "/Volumes/MyPassport/parameter_studies/roughness/roughness_cases/"
ReDim filelist(0)
filelist(0) = myPath
fileAccessGranted = GrantAccessToMultipleFiles(filelist)
For i = 5 To 5
Workbooks("large_and_glaze_adjusted_clean.xlsx").Activate
myName = Cells(i, 1)
fullname = myPath & myName & "LE.xls"
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Workbooks.Open filename:=fullname
Sheets("Ice Tracing").Select
lr = Cells(Rows.Count, 3).End(xlUp).Row
Range("C13:D" & lr).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
fullname = myPath & myName & "_exp.xlsx"
ActiveWorkbook.SaveAs filename:= _
fullname _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
fullname = myName & "LE.xls"
Workbooks(fullname).Activate
Sheets("Ice Tracing Lew").Select
lr = Cells(Rows.Count, 3).End(xlUp).Row
Range("C13:D" & lr).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveAs
Application.CutCopyMode = False
fullname = myPath & myName & "_lew.txt"
ActiveWorkbook.SaveAs filename:= _
fullname _
, FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
fullname = myPath & myName & "LE.xls"
Workbooks(fullname).Activate
ActiveWindow.Close
Next i
End Sub
Saving as an excel workbook works fine. I have tried other text formats and have the same problem.
Sub extract_shape()
'
' extract_shape Macro
'
'
Dim myPath As String
Dim myName As String
Dim fullname As String
Dim i As Long
Dim filelist() As Variant
myPath = "/Volumes/MyPassport/parameter_studies/roughness/roughness_cases/"
ReDim filelist(0)
filelist(0) = myPath
fileAccessGranted = GrantAccessToMultipleFiles(filelist)
For i = 5 To 5
Workbooks("large_and_glaze_adjusted_clean.xlsx").Activate
myName = Cells(i, 1)
fullname = myPath & myName & "LE.xls"
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Workbooks.Open filename:=fullname
Sheets("Ice Tracing").Select
lr = Cells(Rows.Count, 3).End(xlUp).Row
Range("C13:D" & lr).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
fullname = myPath & myName & "_exp.xlsx"
ActiveWorkbook.SaveAs filename:= _
fullname _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
fullname = myName & "LE.xls"
Workbooks(fullname).Activate
Sheets("Ice Tracing Lew").Select
lr = Cells(Rows.Count, 3).End(xlUp).Row
Range("C13:D" & lr).Select
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWorkbook.SaveAs
Application.CutCopyMode = False
fullname = myPath & myName & "_lew.txt"
ActiveWorkbook.SaveAs filename:= _
fullname _
, FileFormat:=xlUnicodeText, CreateBackup:=False
ActiveWindow.Close
fullname = myPath & myName & "LE.xls"
Workbooks(fullname).Activate
ActiveWindow.Close
Next i
End Sub