Click here to Skip to main content
15,868,010 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
I have an VBA code in an excel workbook, which performs several actions like copy the data in the worksheet and paste it to different worksheets in some specific format for further processing by our software.

VBScript
If RunPLS.File_Exist = True Then
        sPresenttActiveSheetName = ActiveSheet.Name
        Dim oldStatusBar
        oldStatusBar = Application.DisplayStatusBar
        Application.DisplayStatusBar = True
        Application.StatusBar = DisplayStringOnStatusBar
        Application.Cursor = xlWait
        
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        Sheets(sSheetBaseFlow).Unprotect
       
        Dim sPLSApplicationPath, sApplicationFolder As String
        Dim oPath, oBatFile, oNewFile As Object
        Set oPath = CreateObject("Scripting.FileSystemObject")
        Set oBatFile = CreateObject("Scripting.FileSystemObject")
        sPLSApplicationPath = GetApplicationPath("PLStudio.exe")
        If sPLSApplicationPath <> "" Then
            'Get instance of FileSystemObject.
            sApplicationFolder = oPath.GetParentFolderName(sPLSApplicationPath)
            exepath = Chr(34) & sPLSApplicationPath & Chr(34) & " /scenariodata  " & Chr(34) & sScenariofile & Chr(34) & "  " & " /StartMinimized /CloseWhenFinished /RunTransient  " & Chr(34) & sPLSFile & Chr(34)
            If Dir(ThisWorkbook.Path & "\XlPLSApp.bat") <> "" Then
            Kill ThisWorkbook.Path & "\XlPLSApp.bat"
            End If
       
            Set oNewFile = oBatFile.CreateTextFile(ThisWorkbook.Path & "\XlPLSApp.bat", True)
            oNewFile.writeline "SET PATH=%PATH%;" & sApplicationFolder
            oNewFile.writeline exepath
            oNewFile.Close
        Else
            MsgBox "Error ! PLS is not installed/registred"
            GoTo Endline
        End If
                     
        PLSPID = Shell(Chr(34) & ThisWorkbook.Path & "\XlPLSApp.bat" & Chr(34), 0)
         
        If RunPLS.SteadyStateStatus = True Then
            Sheets(sSheetBaseFlow).Range("C6").Value = Now
            Sheets(sSheetBaseFlow).Range("F4").Value = "Simulation Successful"
            Sheets(sSheetBaseFlow).Range("F5").Value = "Simulation Successful"
            If RunPLS.LoadWTGFile = True Then
                TerminatePLS.TerminatePLSApplication
                DoEvents
                Workbooks(ThisWorkbook.Name).Activate
                
                Sheets(sSheetBaseFlow).Activate
                RunPLS.RefreshScreenUpdate
                DoEvents
                Sheets(sPresenttActiveSheetName).Activate


Here in the above code there are multiple definitions like ActiveSheet.Name & ThisWorkbook.name like that. The code is working perfectly when only that one workbook is in open condition. and this code is set to run automatically for every 10 minutes.

For suppose, if I am working on one more workbook at the same time when this code is running. Activesheet.Name is taking sheet name of 2nd workbook which I am working on. The same thing is with ThisWorkbook.Name, it is taking 2nd workbook name which i am working instead of 1st workbook name which has code. So this is creating problems as the data is present in 1st workbook.

Kindly request your help in this regard.

What I have tried:

VBScript
sPresenttActiveSheetName = ActiveSheet.Name
Posted
Updated 19-Jan-23 3:58am

1 solution

I would suggest you to work with specific adressing of the Workbooks and Sheets. So you could be sure that you are all time inside the right Workbook / Sheet.
Here an example what I have used :
VBScript
  Dim oWB, aWb As Workbook
   Dim aSh As Worksheet
   QDatei = RechnungsNr + ".xls"
   Quelldatei = Modul1.PrgDaten_Pfad + QDatei
   PrgDatei = Modul1.Programm_Name
   Sheets("Temp-Daten").Cells.Delete Shift:=xlUp
   Set aWb = ActiveWorkbook
 '  Set aSh = Sheets("Formblatt")
   Set aSh = ActiveSheet
  
' Ist die Datei schon vorhanden ?
    Set fs = CreateObject("Scripting.FileSystemObject")
    FileExists = False
    If fs.FileExists(Quelldatei) Then  ' Datei ist als *.XLS vorhanden
       Set oWB = Workbooks.Open(Filename:=Quelldatei, ReadOnly:=True, UpdateLinks:=False)
       FileExists = True
    ElseIf fs.FileExists(Quelldatei + "m") Then  ' Datei ist als *.XLSM vorhanden
       Set oWB = Workbooks.Open(Filename:=Quelldatei + "m", ReadOnly:=True, UpdateLinks:=False)
       FileExists = True
    End If
    
    If FileExists Then
       aWb.Activate
       aSh.Select
       ActiveSheet.Unprotect
       
       [C8] = oWB.Worksheets(1).[C8]
       [c9] = oWB.Worksheets(1).[c9]
       [c10] = oWB.Worksheets(1).[c10]


Of course it isn't complete - but it shows you how to do it ...
 
Share this answer
 

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900