serhat
serhat

Reputation: 51

Browsing Main excel file and Save As directory path with use of Excel VBA

I have below Excel procedure I gather up and I am using it for couple of different calculations under different workbooks. So I was thinking instead changing the procedure for main and outcome files each time, I should be able to pick the file I want to carry out calculations in and the file path for outcomes files.

But I could not find anything for saving directory, I appreciate if you could help

Sub AsBuiltForm()

Dim SaveName As String
Dim mainBook As Workbook

a = InputBox("ENTER FIRST NUMBER ")
b = InputBox("ENTER LAST NUMBER ")

Workbooks.Open Filename:="C:\"  'main file can be browsed? 

Set mainBook = Excel.Workbooks("CP.xlsx")

    For i = a - 1 To b - 1

        mainBook.Sheets(1).Range("bi1") = i + 1
        SaveName = Sheets(1).Range("bi1").value & ".xlsx"

        mainBook.SaveCopyAs "C:\" & SaveName 'save directory?
        Workbooks.Open Filename:="C:\" & SaveName 'save directory?

        With Excel.ActiveWorkbook
            .Sheets("1 of 2").Range("A1:CT103").value = Sheets("1 of 2").Range("A1:CT103").value
            .Sheets("2 of 2").Range("A1:CT103").value = Sheets("2 of 2").Range("A1:CT103").value
            Excel.Application.DisplayAlerts = False
            .Sheets("Sheet1").Delete
            .Sheets("il oufall").Delete

            .Sheets("1 of 2").Select
            Columns("Bh:BZ").Select
            Selection.Delete Shift:=xlToLeft

            .Sheets("2 of 2").Select
            Columns("Bn:BZ").Select
            Selection.Delete Shift:=xlToLeft

            .Close True

        End With

    Next

mainBook.Close False
Set mainBook = Nothing

End Sub

Upvotes: 0

Views: 2822

Answers (3)

serhat
serhat

Reputation: 51

Yes, browsing file works now; all the ins and outs aside, the problem i face with naming the file due to the variable "bi1" and saving as many loop as i asked for. I check several times before i bother you but i do not think i have the sufficient info to address "fn" as file in the use of Application.GetOpenFileName .

Option Explicit

Sub AsBuiltForm()

    Dim fn
    Dim myFolder As String
    Dim SaveName As String, a As Integer, b As Integer, i As Integer      

    myFolder = BrowseFolder("Pick a Folder Where to Save")

    MsgBox "Choose Calculation File "
     fn = Application.GetOpenFilename

Workbooks.Open fn                

    a = InputBox("ENTER FIRST NUMBER ")
    b = InputBox("ENTER LAST NUMBER ")        

For i = a - 1 To b - 1 Step 1

Application.DisplayAlerts = False

Workbooks.Open Filename:=fn

    Range("bi1") = i + 1

    SaveName = ActiveWorkbook.Sheets(1).Range("bi1").value

    Sheets(1).Range("A1:CT103").value = Sheets(1).Range("A1:CT103").value

    Sheets(2).Range("A1:CT103").value = Sheets(2).Range("A1:CT103").value

    Application.ActiveWorkbook.SaveAs myFolder & SaveName


    ActiveWorkbook.Close True

    Next

End Sub  

Function BrowseFolder(Optional Caption As String, Optional InitialFolder As String) As String

' based on Browse For Folder from:
' http://www.cpearson.com/excel/BrowseFolder.aspx
' this functions requires that the following Reference is active:
    'Microsoft Shell Controls and Automation

Const BIF_RETURNONLYFSDIRS As Long = &H1

Dim wsh As Object
Dim SH As Shell32.Shell
Dim F As Shell32.Folder

Set wsh = CreateObject("Wscript.Shell")
Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
    If F = "Desktop" Then
        BrowseFolder = wsh.Specialfolders(F)
    Else
        BrowseFolder = F.Items.Item.Path
    End If
End If    
End Function

Upvotes: 0

Olle Sjögren
Olle Sjögren

Reputation: 5385

The following is not really an answer to your question, but a few tips to improve your code, and too long to add as a comment.

Workbooks.Open returns a Workbook object you can save the reference, so you don't have to rely on ActiveWorkbook:

Dim oWorkbook As Workbook

Set oWorkbook = Workbooks.Open(Filename:="C:\" & SaveName)

'***** Do something with oWorkbook
Debug.Print oWorkbook.FullName

Set oWorkbook = Nothing

A few other hints:

  • Use Option Explicit at the top of every module to force explicit declaration of all variables in order to find typos and other errors earlier.

  • Avoid selecting cells

Upvotes: 0

Scott Holtzman
Scott Holtzman

Reputation: 27249

You can use Application.GetOpenFileName to pick files that you want to open at Run-Time.

You can use the function below to browse for a folder where you wish to save a file.

Sub FindFolder()

Dim myFolder as String
myFolder = BrowseFolder("Pick a Folder Where to Save")

End Sub

Function BrowseFolder(Optional Caption As String, Optional InitialFolder As String) As String

' based on Browse For Folder from:
' http://www.cpearson.com/excel/BrowseFolder.aspx
' this functions requires that the following Reference is active:
    'Microsoft Shell Controls and Automation

Const BIF_RETURNONLYFSDIRS As Long = &H1

Dim wsh As Object
Dim SH As Shell32.Shell
Dim F As Shell32.Folder

Set wsh = CreateObject("Wscript.Shell")
Set SH = New Shell32.Shell
Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)
If Not F Is Nothing Then
    If F = "Desktop" Then
        BrowseFolder = wsh.Specialfolders(F)
    Else
        BrowseFolder = F.Items.Item.path
    End If
End If

End Function

Upvotes: 1

Related Questions