Option Explicit Declare PtrSafe Function ShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" ( _ ByVal hWnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Function OpenAnyFile(FileToOpen As String) Call ShellExecute(0, "Open", FileToOpen & vbNullString, _ vbNullString, vbNullString, 1) End Function Function RemovePunctuation(r As String) As String With CreateObject("vbscript.regexp") .Pattern = "[^*/.()-=+[]<>A-Z0-9 ]" 'Given are the various symbols that the function will keep in the STAAD file .IgnoreCase = True .Global = True RemovePunctuation = .Replace(r, "") End With End Function Sub STAADCreatorUls() Dim stdFile As Object Dim ws As Worksheet Dim cll As Range Dim fpath As String Dim LastRow As Long Set ws = Worksheets("STAAD INPUT ANALYSIS") 'Your worksheet name or activeworksheet property can be used fpath = Application.ActiveWorkbook.Path If Right(fpath, 1) <> "\" Then fpath = fpath & "\" LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'Here all the input is as text in column A With CreateObject("Scripting.FileSystemObject") Set stdFile = .CreateTextFile(fpath & "STAAD_ULS.std", True) 'Your STAAD File name ''''''''''''''''''''''''''''''''''''''''''''''''' 'i want to create a new folder in same dic. and move "STAAD_ULS.std" in it then open' 'i'm create 4 file with same process. '''''''''''''''''''''''''''''''''''''''''''''''''''''' End With For Each cll In ws.Range("A4:A" & LastRow) stdFile.WriteLine (RemovePunctuation(cll.Value)) Next cll stdFile.Close Call OpenAnyFile(ThisWorkbook.Path & "\STAAD_ULS.std") 'Command to open your STAAD file End Sub
Bookmarks